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