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 
*                        <error return> 
      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.RTR 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
      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