ASMB,R,L,C,N HED I.D. SEG. ADDRESS ROUTINE *(C) HEWLETT-PACKARD CO. 1976* IFN NAM PGMAD,7 91700-16152 REV.A 760117 EXT .ENTR XIF IFZ NAM PGMAD,14 91700-16152 REV.A 760117 EXT .ENTP,$LIBR,$LIBX XIF ENT PGMAD SPC 1 * NAME: PGMAD * SOURCE: 91700-18152 * RELOC: 91700-16152 * PGMR: C.C.H. [ 01/17/76 ] [LIBERALLY EXTRACTED FROM 'SCHED'] SPC 1 ****************************************************************** * * (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. * ****************************************************************** SPC 1 * PGMAD ACCEPTS A USER-SUPPLIED ADDRESS OF A 3-WORD ARRAY WHICH * CONTAINS THE ASCII CODE FOR THE NAME OF A PARTICULAR PROGRAM. * PGMAD RETURNS THE I.D. SEGMENT ADDRESS OF THE PROGRAM, IT'S STATUS, * AND AN INDICATION OF THE TYPE OF I.D. SEGMENT; I.E.,LONG/SHORT. * * PGMAD CALLING SEQUENCE: * * JSB PGMAD * DEF *+2 [ OR *+2+N WHERE N= NUMBER OF OPTIONAL PARAMETERS ] * DEF NAME ADDRESS OF 3-WORD ASCII PROGRAM NAME ARRAY. * [DEF IDAD] [OPTIONAL ADDRESS FOR RETURN OF I.D. SEG. ADDRESS] * [DEF ISTAT] [OPTIONAL ADDRESS FOR RETURN OF PROGRAM STATUS] * [DEF IDTYP] [OPTIONAL ADDRESS FOR RETURN OF I.D.SEGMENT TYPE] * = I.D. SEGMENT ADDRESS. * = PROGRAM STATUS. * = 0: STANDARD 28-WORD I.D. SEGMENT. * = 1: SHORT(PROGRAM SEGMENT) 9-WORD I.D. SEGMENT. * * FORTRAN CALLING SEQUENCE: CALL PGMAD(NAME [,IDAD [,ISTAT [,IDTYP]]]) * OR * REG=PGMAD(NAME [,IDAD [,ISTAT [,IDTYP]]]) * * PGMAD ERROR DETECTION: * * A. ADDRESS OF NAME-ARRAY NOT SUPPLIED. * B. CHARACTER #5 OF USER-SUPPLIED PROGRAM NAME IS NULL. * C. I.D. SEGMENT WITH EQUIVALENT PROGRAM NAME CANNOT BE FOUND. * * -- RETURN TO WITH: * * 1. & AND 'IDAD' & 'ISTAT' ALL SET = 0. * 2. AND 'IDTYP' ARE SET =1. * NAME NOP ADDRESS OF ASCII NAME ARRAY. P1 DEF A ADDRESS FOR RETURN OF PARAMETER #1. P2 DEF B ADDRESS FOR RETURN OF PARAMETER #2. P3 DEF PTEM ADDRESS FOR RETURN OF PARAMETER #3. SUP [SUPPRESS EXTENDED LISTING] PGMAD NOP ENTRY/EXIT: I.D.SEG. ADDRESS ROUTINE. IFN JSB .ENTR OBTAIN DIRECT ADDRESSES. XIF IFZ JSB $LIBR DEFINE THIS SUBROUTINE NOP TO BE PRIVILEGED. JSB .ENTP GET DIRECT ADDRESSES--PRIVILEGED MODE. XIF DEF NAME DEFINE PARAMETER STORAGE AREA. SPC 1 LDA NAME GET THE ADDRESS OF THE ASCII ARRAY. SZA,RSS DID THE CALLER SUPPLY AN ADDRESS? JMP ERREX NO--ERROR! SPC 1 * RESET POINTERS TO ALLOW USER TO CALL WITHOUT RETURN-DATA PARAMETERS. SPC 1 DLD P1 GET PARAMETER ADDRESSES-IF ANY. DST IDAD SAVE FOR DATA RETURN. DLD REGDF GET INITIAL PARAMETER DEFINITION DST P1 AND RE-INITIALIZE FOR NO PARAMETERS. LDA P3 GET 'IDTYP' PARAMETER ADDRESS--IF ANY. LDB DPTEM GET DEF TO DUMMY PARAMETER STORAGE. STA IDTYP SAVE PARAMETER ADDRESS. STB P3 RE-INITIALIZE FOR NO 'IDTYP' PARAMETER. * LDB NAME GET ADDRESS OF NAME ARRAY. STB PTEM SAVE ADDRESS OF 1RST & 2ND CHARACTERS. INB POINT TO 2ND TWO CHARS. OF NAME ARRAY. STB PTEM+1 SAVE ADDRESS OF 3RD & 4TH CHARS. INB POINT TO LAST CHARACTER'S ADDRESS. LDA B,I GET THE WORD FROM THE NAME ARRAY. AND UBYTE ISOLATE CHAR.#5 FROM UPPER BYTE. STA PTEM+2 SAVE CHAR.#5 LOCALLY. SZA FORCE ERROR-RETURN FOR A NULL CHARACTER. LDA KEYWD GET ADDRESS OF KEYWORD TABLE. STA KEYPT SET POINTER TO TOP OF TABLE. PLOOP LDA KEYPT,I GET THE KEYWORD-TABLE ENTRY. CCE,SZA,RSS IF THIS IS THE END-OF-LIST (0), JMP ERREX THEN GO TO RETURN AN ERROR INDICATION. * ADA P12 POINT TO NAME-CHARS.1 & 2 IN I.D. SEG. LDB A,I GET CHARS. 1 & 2 FROM I.D. SEGMENT. CPB PTEM,I IF THEY ARE THE SAME AS USER'S CHARS., INA,RSS THEN PROCEED WITH COMPARISON; ELSE, JMP PNEXT GO TO GET NEXT KEYWORD ENTRY. * LDB A,I GET CHARS. 3 & 4 FROM THE I.D. SEGMENT. CPB PTEM+1,I IF THESE TWO COMPARE TO USER'S CHARS, INA,RSS THEN CONTINUE CHECKING; ELSE, JMP PNEXT GO TO GET NEXT KEYWORD ENTRY. * STA PSTAT SAVE ADDRESS TO GET STATUS--LATER. LDA A,I GET THE LAST CHAR. FROM I.D. SEGMENT. STA B SAVE THE WORD FOR SHORT I.D. TESTING. AND UBYTE ISOLATE CHARACTER #5 FROM I.D. SEG. CPA PTEM+2 IF THIS IS A FINAL MATCH, THEN JMP PFOUN GO TO GATHER DATA FOR THE RETURN. * PNEXT ISZ KEYPT POINT TO NEXT KEYWORD ENTRY. JMP PLOOP GO TO CHECK NEXT KEYWORD ENTRY. * ERREX CLA,CCE,INA SET 'IDTYP' & STA IDTYP,I TO 1--FOR ERROR-RETURN. CLA RETURN WITH & AND 'IDAD' & CLB 'ISTAT' ALL SET TO ZERO! JMP EROUT GO TO RETURN THE BAD NEWS. * PFOUN LSR 4 MOVE THE SHORT I.D. BIT TO . CLE,ERB SET TO: 0-LONG/1-SHORT ID.SEG. TYPE. CLA,SEZ IF STANDARD I.D. SEG.: =0; ELSE, INA SET =1 FOR SHORT I.D. SEGMENT. STA IDTYP,I RETURN THE I.D. SEGMENT TYPE. LDA KEYPT,I = I.D. SEGMENT ADDRESS. ISZ PSTAT POINT TO I.D. SEGMENT STATUS WORD. LDB PSTAT,I = PROGRAM'S CURRENT STATUS. EROUT STA IDAD,I RETURN DATA TO STB ISTAT,I USER'S PARAMETERS--IF ANY. IFN JMP PGMAD,I RETURN TO CALLER. XIF IFZ JSB $LIBX RETURN TO CALLER DEF PGMAD VIA PRIVILEGED PROCESSOR. XIF * A EQU 0 B EQU 1 DPTEM DEF PTEM DUMMY POINTER: PARAMETER #3. IDAD NOP ADDRESS FOR RETURN OF I.D. SEG. ADDRESS. ISTAT NOP ADDRESS FOR RETURN OF PROGRAM STATUS. IDTYP NOP ADDRESS FOR RETURN OF I.D. SEGMENT TYPE. KEYPT NOP POINTER TO CURRENT I.D. SEGMENT ADDRESS. KEYWD EQU 1657B BASE PAGE ADDRESS OF KEYWORD TABLE. P12 DEC 12 OFFSET TO I.D. SEGMENT NAME-ENTRY. PSTAT NOP TEMPORARY STORAGE. PTEM OCT 0,0,0 TEMPORARY STORAGE. REGDF DEF A DUMMY POINTER: PARAMETER #1. DEF B DUMMY POINTER: PARAMETER #2. UBYTE OCT 177400 UPPER-BYTE ISOLATION MASK. SPC 1 END