ASMB,L,C
      NAM GEX.C,7 92060-16105 781127 REV. 1901 $CLIB
      SPC 3 
*    NAME:    GEX.C 
*    SOURCE:  92060-18069 
*    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 3 
* THIS PROCEDURE HANDLES SEVERAL OF THE DIFFERENCES BETWEEN RTE-IV 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 
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 
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
      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.     GET THE PARAMETER 
      JSB GETRK     GET A TRACK 
      JSB EXEC      WRITE OUT THE SKELETON TO DISC
      DEF *+6+1 
      DEF .2
      DEF DLU 
      DEF .PRAM,I 
      DEF .9
      DEF TRACK 
      DEF .0
      LDA TRACK     PACK TRACK & LU 
      ALF,ALF 
      RAR,RAR 
      IOR DLU 
      STA TRLU
      JSB EXEC      CALL D.RTR
      DEF *+7+1 
      DEF QSKED 
      DEF D.RTR 
      DEF MYID
      DEF TRLU
      DEF CR
      DEF .0
      DEF FUNCT 
      JSB GIVBK     GIVE THE TRACK BACK TO THE SYSTEM 
      JMP FETCH     EXIT CASE 
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 
      INB           .PRAM IS IN B ALSO
      STB .R2 
      INB 
      STB .R3 
      JSB EXEC      CALL D.RTR
      DEF *+7+1 
      DEF QSKED 
      DEF D.RTR 
      DEF IMYID 
      DEF .PRAM,I 
      DEF .R2,I 
      DEF .R3,I 
      DEF CR
      JMP FETCH     EXIT CASE 
* 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  ] 
      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; ] 
      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 =D6 
      SZA,RSS 
      ADB =D2 
      STB FUNCT 
      LDA C.EXT 
      STA .PRAM 
      JMP CEXEC 
      SPC 2 
CLOSE JSB INDC.     MAKECLOSECALL 
CEXEC JSB EXEC
      DEF *+7+1 
      DEF QSKED 
      DEF D.RTR 
      DEF MYID
      DEF .PRAM,I 
      DEF C.FAD,I 
      DEF C.FAD+1,I 
      DEF FUNCT 
      JMP FETCH 
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 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 LDA B         PRAM ADDRESS TO A 
      CLB,CCE 
      ERB 
      JSB P.PAS     FETCH THE RETURN PARAMETERS 
      DEC -5
.R1 BSS 1 
.R2 BSS 1 
.R3 BSS 1 
.R4 BSS 1 
.R5 BSS 1 
      ISZ GEX.C 
      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 
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 
.PRAM EQU .R1 
NAME  EQU .R2 
TRLU  EQU .R4 
IDPTR BSS 1 
IMYID EQU .R5 
NLU   EQU .R5 
      END