ASMB,L,C
      NAM GEX.L,7 92070-1X282 REV. 2040 800725 $CLIB
      SPC 3 
*    NAME:    GEX.C 
*    SOURCE:  92070-18282 
*    PGMR:    EARL STUTES 
*      modified for LC by SAM HANSEN
* 
*   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 3 
* THIS PROCEDURE HANDLED SEVERAL OF THE DIFFERENCES BETWEEN RTE-IV AND
* RTE II-III AND RTE-M FOR THE COMPILER LIBRARY -- THIS NEW VERSION 
* HANDLES RTE-LC
* 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 (NO PRAM) 
*    5 => CLOSE SCRATCH FILE (NO PRAM OR ERROR RTRN)
* 
* 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
      EXT .R1       D.RTR RETRN PARAM #1    ERROR(-)\SECTORS(+) 
      EXT .R2       D.RTR RETRN PARAM #2    TR,LU        \   DIRCTORY 
      EXT .R3       D.RTR RETRN PARAM #3    OFSET,SECTR  /   ADRS 
      ENT .R6       D.RTR RETRN  SECURITY CODE
      ENT .R7       D.RTR RETRN  TYPE CODE
      EXT .P1       D.RTR PASS PARAM #1     FUNCTION CODE 
      EXT .P2       D.RTR PASS PARAM #2 
      EXT .P3       D.RTR PASS PARAM #3 
      EXT .P4       D.RTR PASS PARAM #4 
      EXT .P5       D.RTR PASS PARAM #5 
      EXT .P6       D.RTR PASS PARAM #6 
      EXT .P7       D.RTR PASS PARAM - NOP  ??? 
      EXT .P8       D.RTR PASS PARAM - NOP  ??? 
      EXT .P9       D.RTR PASS PARAM #7     ??? 
      SPC 4 
* BEGIN 
*   CASE FUNCTION OF
*     MAKECLOSECALL;
*     MAKECREATCALL;
*     MAKEOPENCALL; 
*     MAKEOPENEXTCALL;
*     DOSCRATCHOPENTRICK; 
*     DOSCRATCHCLOSETRICK;
*   ESAC; 
*   FETCHRETURNPRAMETERS; 
*   IF ERROR THEN 
*     GO ERROR EXIT;
*   IF FUNCTION = NEWOPEN 
* END OF CALLD.RTR
      SKP 
      ENT GEX.C 
      ENT PROBT 
      EXT .MBT      BYTE MOVE WORDS 
      EXT CLD.R     ROUTINE WHICH CALLS D.RTR 
      EXT EXEC
      EXT C.FAD     FCB FILE DIRECTORY WORD 
      EXT C.FID     FCB ID WORD 
      EXT C.#SC     FCB EXTENT SIZE 
      EXT C.BFF     BUFFER FOR DIRECTORY ENTRY
      EXT C.EXT     FCB EXTENT COUNTER
      EXT LIMEM     RTE-M GET MEMORY LIMITS PROCEDURE 
      EXT PNAME     RETURNS PROGRAM NAME
A     EQU 0 
B     EQU 1 
PROBT OCT 7700      DISC PROTECT BITS 
FUNCT BSS 1         THE PASSED IN FUNCTION PARAMETER
CR    BSS 1         THE PASSED IN CR PARAMETER
.1    DEC 1 
.3    DEC 3 
.5    DEC 5 
.9    DEC 9 
.128  DEC 128 
.R6   BSS 1         NEEDED ENTRY SINCE D.RTR DOESN'T RTRN SEC 
.R7   BSS 1         NEEDED ENTRY SINCE D.RTR DOESN'T RTRN TYP 
NEWOP EQU .9        NEW OPEN FUNCTION CODE
TRACK BSS 1 
B.P3  DEF .P3+0 
B.P4  DEF .P4+0 
      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 
CREAT JSB INDC. 
      LDA B,I 
      STA .P3 
      INB           .PRAM IS STILL IN B 
      LDA B,I 
      STA .P4 
      INB 
      LDA B,I 
      STA .P5 
      CLA,INA 
      STA .P1 
      LDA CR
      STA .P2 
      ADB =D5 
      LDA B,I       FETCH THE RECORD SIZE 
      STA .P8 
      INB 
      LDB B,I          FETCH THE SECURITY CODE
      STB .P9 
      LDB .PRAM 
      ADB =D3 
      LDA B,I       GET THE TYPE CODE 
      STA .P6 
      ADB =D3 
      LDB B,I       GET THE FILE SIZE 
      STB .P7 
      JMP FETCH 
      SPC 3 
NOPEN JSB INDC. 
      LDA .PRAM,I   MAKEOPENCALL
      IOR =B100000  SET THE EXCLUSIVE OPEN BIT IN THE NAME
      STA .P3 
      INB           .PRAM IS STILL IN B 
      LDA B,I 
      STA .P4 
      INB 
      LDA B,I 
      STA .P5 
      LDA CR
      STA .P2 
      LDA NEWOP 
      STA .P1       FIX UP THE FUNCTION CALL
      JMP FETCH 
      SPC 3 
EOPEN EQU * 
      JSB INDC. 
      LDA .PRAM,I   MAKEOPENEXTCALL 
      LDB =D6 
      SZA,RSS 
      ADB =D2 
      STB .P1 
      LDA C.EXT,I 
      STA .P4 
      JMP CEXEC 
      SPC 2 
CLOSE JSB INDC. 
      CLA 
      STA .P5 
      STA .P1 
      LDA .PRAM,I 
      STA .P4 
CEXEC DLD C.FAD,I 
      STA .P2 
      STB .P3 
      JMP FETCH 
      SPC 3 
* SCRATCH OPEN FOR THE RTE-LC 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
      ALF,ALF 
      STA .P3 
      JSB PNAME 
       DEF *+2
       DEF .P4
      LDA B.P4
      LDB B.P3
      RRL 1 
      INB 
      JSB .MBT
      DEF .5
      NOP 
      CLA 
      STA .P8       RECORD SIZE 
      STA .P9       SECURITY CODE 
      STA .P2    -LU,CRN# 
      INA 
      STA .P1       FUNCTION - CREATE 
      LDA =D3 
      STA .P6       TYPE
      LDB =D24
      STB .P7       FILE SIZE 
      JSB CLD.R     CALL D.RTR
* PICK UP THE RETURN PARAMETERS 
      LDA .R1 
* IF NOT((RETURNP1 = -2) OR (RETURNP1 >= 0)) THEN 
      SSA,RSS 
      JMP OPNIT 
      CPA =D-2        DUPLICATE NAME
      JMP OPNIT 
*   GO ERROR EXIT 
      JMP GEX.C,I 
* OPEN THE FILE EXCLUSIVE 
OPNIT LDA .P3 
      IOR =B100000
      STA .P3 
      LDA NEWOP 
      STA .P1 
* GO FINISH UP JUST LIKE A NEW OPEN 
      JMP FETCJ     NO DEF IN SCR OPEN
      SPC 3 
SCLOS CLA 
      STA .P1 
      STA .P5 
      LDA C.EXT,I 
      INA 
      MPY C.#SC,I  NUMBER OF SECTORS TO PURGE 
      ALS 
      CMA,INA 
      STA .P4 
      DLD C.FAD,I 
      STA .P2 
      STB .P3 
      JSB CLD.R     CALL D.RTR
      JMP GEX.C,I   NO ERROR RTN OR DEF IN SCR CLOSE
*  ESAC;
      SPC 3 
FETCH ISZ GEX.C     JUMPS OVER DEF
FETCJ JSB CLD.R     CALL D.RTR
      LDA .R1       CHECK FOR ERRORS
      SSA 
      JMP GEX.C,I   ERROR OUT 
*   IF FUNCTION = NEWOPEN 
      LDA .P1 
      CPA .1
      JMP FILID 
      CPA NEWOP 
      JMP *+2 
      JMP EXIT
      LDA .R2       TRACK\LU
      AND =B77     ISOLATE LU#
      IOR PROBT     ADD DISC PROTECT BITS 
      STA .R7       LU (DISC) 
      LDA .R2 
      ALF,ALF 
      RAL,RAL 
      AND =B1777
      STA TRACK 
      LDA .R3       OFFSET\SECTOR 
      AND =B377 
      STA .R6       SECTOR
      JSB EXEC      FETCH THE DIRECTORY ENTRY 
      DEF *+7 
      DEF .1
      DEF .R7 
      DEF C.BFF,I 
      DEF .128
      DEF TRACK 
      DEF .R6 
      LDA .R3       OFFSET\SECTOR 
      ALF,ALF 
      AND =B377     OFFSET
      ADA .3
      ADA C.BFF 
      LDB A,I       TYPE IS 4TH WORD OF DIRECTORY ENTRY 
      STB .R7 
      ADA .5
      LDB A,I       SECURITY CODE IS IN 9TH WORD
      STB .R6 
FILID LDA .R2 
      LDB .R3 
      DST C.FAD,I 
EXIT  ISZ GEX.C     JUMPS OVER ERROR EXIT 
      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 
* 
* 
.PRAM BSS 3 
      END