ASMB,R,Q,C
      HED <<RTE-BASIC PARAMETER PASSER>>      92076-1X034 REV.2001
      NAM CALSB,7 92076-1X034 REV.2040 800721 
* 
* 
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
* 
* 
*           RELOC:     PART OF 92076-12001
*           SOURCE:    92076-18034
* 
* 
*     THIS ROUTINE TRANSFERS THE PARMATERS FROM/TO BASIC TO/FROM
*     NON-BASIC SUBROUTINES.  THE PARMETERS ARE PLACED IN SAM 
*     THEN RETRIEVED VIA CLASS I/O CALLS.  CALSB UTILIZES THE 
*     INFORMATION IN THE DESCRIPTOR BLOCKS AS DESCRIBED IN
*     BASIC SEGMENT 4 ECALL SECTION TO BUILD A BUFFER FOR EACH
*     PARAMETER.  CALSB ALLOCATES THE MEMORY FOR THESE BUFFERS
*     UTILIZING THE MEMORY MANAGEMENT CALLS BFGET, RETBF, CMPK, AND 
*     AVLM WHICH ARE PART OF THE COMPILER LIBRARY.
* 
*     THE NON-BASIC SUBROUTINES (AND BASIC, IF APPLICABLE) HAVE THE 
*     ADDRESSES TO THE PARAMETER BUFFERS (UP TO 15) PAST TO IT.  THESE
*     ADDRESSES POINT TO THE LENTGH WORD, IN THE CASE OF A STRING VALUE,
*     OR THE ACTUAL DATA FOR NUMERIC VALUES.
* 
*     THIS PARAMETER ADDRESS-1 POINTS TO THE STRING FLAG WORD.  THE 
*     POSSIBLE VALUES OF THIS WORD ARE: 
* 
*               <0 = STRING VALUE PASSED
*              >=0 = NUMERIC VALUE PASSED 
* 
********************************************************************* 
* 
* 
* 
*                   RTE-BASIC PARAMETER TRANSFER ROUTINE
* 
      ENT FWAFS,LWAFS,CALSB,DESPT 
      ENT RFLAG,FWPWA 
      SPC 3 
      EXT RMPAR,EXEC,PRTN,#RSFG 
      EXT ERROR,LUERR,ERRCD,.LNUM 
      EXT BFGET,RETBF,CMPK,AVLM 
      SPC 3 
* 
      SUP PRESS MULTIWORD OCTAL LISTINGS
      SPC 3 
CALSB NOP 
      JSB RMPAR     FETCH PARAMETERS
       DEF *+2
       DEF SUB# 
      LDA LUER         STORE ERROR LUN
      STA LUERR          TO ERROR ROUTINE 
      LDA LNUM         STORE CURRENT LINE NUMBER
      STA .LNUM          TO ERROR ROUTINE 
      SPC 1 
* 
*  CHECK TO SEE IF OVERLAY IS BEING CALLED FROM BASIC 'BYE' 
*  TO PERMANENTLY TERMINATE ITSELF
* 
      LDA SUB#      IS THIS 
      CPA AB          AN ABORT? 
      RSS           YES!
      JMP CALS0     NO, CONTINUE
      JSB EXEC      TERMINATE 
      DEF *+3         OVERLAY 
      DEF .6
      DEF .0
* 
      SPC 1 
**************************REMOVED 800721***************************** 
*CALS0 JSB EXEC      NOTIFY THE 
*       DEF *+3        OPERATING SYSTEM 
*       DEF .22          TO SWAP WHOLE  
*       DEF .3             FOREGROUND AREA  
***********************800721*****************************************
      SPC 1 
CALS0 LDA SUB#      FETCH 
      ADA CALSB,I     SUBROUTINE
      LDA 0,I           ENTRY 
      RAL,CLE,SLA,ERA     ADDRESS 
      JMP *-2               FROM
      STA SUB#                DIRECTORY 
* 
      LDB M15       CLEAR ALL 
      LDA PADDR       OLD 
      STA PADPT         SUBROUTINE
      CLA                 DEF'S OUT SO
      STA PADPT,I           AS NOT TO CONFUSE 
      ISZ PADPT               THOSE SUBROUTINES 
      INB,SZB                   THAT MAY HAVE OPTIONAL
      JMP *-3                     PARAMETERS
* 
      LDB M15       CLEAR ALL 
      LDA BUFAD       OLD 
      STA BUFPT         BUFFER
      CLA                 POINTERS. 
      STA BUFPT,I 
      ISZ BUFPT 
      INB,SZB 
      JMP *-3 
      SKP 
      JSB BFGET     GET A BUFFER
       DEF *+4        FOR THE 
       DEF .46          DESCRIPTOR
       DEF DESAD          BLOCK.
       DEF IERR            (PLACE HOLDER ONLY)
* 
      SSA           SUCCESSFUL? 
      JMP NOMEM     NO, ERROR.
* 
      JSB EXEC      READ IN THE 
       DEF *+5        DESCRIPTOR
       DEF .21          BLOCK 
       DEF CLASS          FROM CLASS
       DEF DESAD,I          TO BUFFER 
       DEF .46
      SPC 1 
      SSA           DID WE GET IT ? 
      JMP BADXF       NO
      STB DBSIZ       YES, SAVE SIZE OF BLOCK 
      LDA PADDR     PRESET POINTER TO 
      STA PADPT       PARAMETER LIST
      JSB PINIT     SET UP POINTER & COUNTER
      JMP CALS9       AND BEGIN PARAMETER TRANSFER
      SPC 2 
PINIT NOP 
      LDA DESAD,I   INITIALIZE COUNTER
      CMA 
      STA PCNT
      LDA DESAD       AND POINTER TO
      ADA DBSIZ         DESCRIPTOR BLOCK
      ADA M3              ENTRY FOR FIRST 
      STA DESPT             PARAMETER 
      LDA BUFAD       AND POINTER TO
      STA BUFPT         PARAM. BUFFER POINTERS. 
      JMP PINIT,I 
      SKP 
CALS1 LDB DESPT,I   PICK UP RECORD LENGTH 
      LDA DESPT 
      ADA .2
      LDA 0,I 
      SSA,RSS       STRING? 
      JMP CLS1A      NO, WORDS NOT CHARS! 
      CLA           PUT 
      STA NFLAG       FALSE IN NUMBER FLAG, 
      RRR 8          LOGICAL LENGTH IN (A)
      ALF,ALF           AND PHYSICAL LENGTH IN (B)
      STA TEMP            SAVE (+) CHARS AS STRING HEADER 
      CMA,INA       IS ARRAY DIM >= ACTUAL CHAR. COUNT? 
      ADA 1           LONGER THAN 
      SSA               OR AS LONG AS LOGICAL LENGTH? 
      LDB TEMP      NO, SO USE LOGICAL LENGTH 
      CLE,ERB       USING PHYSICAL LENGTH CONVERT TO WORDS
      SEZ             ALLOWING FOR
      INB               ODD CHARACTER 
      LDA DESPT     SET UP
      INA 
      STB 0,I         BUFFER LENGTH 
      INB               INCLUDE LENGTH WORD 
      STB LENTH 
      JMP CALS2 
* 
CLS1A CCA           SET NUMBER FLAG 
      STA NFLAG       TO TRUE.
      LDB DESPT     FETCH THE 
      LDA 1,I 
      STA LENTH 
      INB             BASE ADDRESS
      DLD 1,I           AND ARGUMENT ADDRESS
      CMA,INA       OFFSET THE
      ADA 1           PARAMETER 
      STA TEMP          POINTER 
      SPC 1 
CALS2 ISZ LENTH     ADD ONE STRING FLAG WORD TO BUFFER
      JSB BFGET         ALLOCATE
       DEF *+4            BUFFER
       DEF LENTH            FOR 
       DEF BUFPT,I            PARAMETER.
       DEF IERR        (PLACE HOLDER ONLY)
* 
      SSA           SUCCESSFUL? 
      JMP NOMEM       NO, MEMORY ERROR. 
* 
      LDA BUFPT,I     YES 
      STA TEMP2       SAVE ADDRESS OF BUFFER. 
* 
      LDB NFLAG     PARAMETER 
      SSB             NUMERIC?
      JMP CALS4     YES 
* 
      LDB MNEG      NO, INDICATE STRING WITH MINUS #
      STB TEMP2,I   STORE IT IN FIRST WORD OF BUFFER
      ISZ TEMP2     POINT TO LENGTH WORD
      INA           INCREMENT TO POINT PARM. ADDR TO LENGTH WORD
      LDB TEMP      PUT + CHAR. COUNT 
      STB TEMP2,I     IN LENGTH WORD OF 
      STA PADPT,I       BUFFER AND
      INA                 INCREMENT FOR 
      STA TEMP2             READ. 
      LDA M2        SET UP TRUE LENGTH OF STRING
      ADA LENTH     FOR THE READ
      STA LENTH     EXCLUDING THE LENGTH AND STRING FLAG WORDS. 
      JMP CLGET 
* 
CALS4 CLB           NUMERIC, ZERO OUT STRING FLAG WORD
      STB TEMP2,I   TO INDICATE NO STRING VALUE 
      ISZ TEMP2     POINT TO WOULD-BE LENGTH WORD 
      INA           INCREMENT TO POINT PARM. ADDR. TO WOULD-BE
      ADA TEMP      LENGTH WORD AND GET 
      STA PADPT,I     ELEMENT ADDRESS 
      CCA 
      ADA LENTH      DECREMENT TO TRUE LENGTH 
      STA LENTH      FOR NUMERIC
* 
CLGET JSB EXEC      READ IN 
       DEF *+5        A RECORD
       DEF .21
       DEF CLASS
       DEF TEMP2,I
       DEF LENTH
      SPC 1 
      SSA           RECORD GOT ?
      JMP CALS5       NO
      LDA DESPT       YES, POINT TO 
      ADA M3            NEXT DESCRIPTOR 
      STA DESPT           TRIPLET 
      ISZ PADPT             AND NEXT LIST ENTRY 
      ISZ BUFPT          AND NEXT BUFFER POINTER. 
CALS9 LDA PCNT      MORE PARAMETERS?
      INA 
      STA PCNT
      SSA 
      JMP CALS1       YES 
      SKP 
      LDB DMMYA     SET UP DUMMY
      STB TEMP2       BUFFER
      CLB,INB       SET SIZE = 1
      STB LENTH 
      JMP CLGET     LOOP UNTIL CLASS EMPTY
      SPC 2 
CALS5 LDA PCNT      MORE PARAMETERS ? 
      SZA 
      JMP BADXF       YES, TOO BAD
      STA ERRCD       NO, PRESET ERROR CODE 
      JSB PINIT         AND DESBLK POINTER
* 
*             HERE IS WHERE THE ROUTINE 
*               ACTUALLY GETS CALLED
* 
      JSB SUB#,I
       DEF *+16 
PLIST  BSS 15       SPACE HERE FOR PARAMETER ADDRESSES
* 
      DST ABREG     SAVE RETURNED VALUE, IF ANY 
      LDA ERRCD     SUBROUTINE
      SZA             ERROR ? 
      JMP CRET6         YES, ABANDON SHIP 
      JMP CRET4 
* 
SUB#  BSS 1         KEEP THESE
CLASS BSS 1           IN ORDER
NVFLG BSS 1             ALL FIVE OR ELSE
LUER  DEC 1         ERROR LOGICAL UNIT NUMBER 
LNUM  NOP           CURRENT LINE NUMBER 
      SKP 
CRET1 LDA DESPT,I 
      STA TEMP     SAVE BLOCK LENGTH
      LDA DESPT 
      ADA .2
      LDA 0,I       STRING? 
      SSA,RSS       IS THIS A STRING ?
      JMP CRET3       NO
      LDA TEMP2,I     YES, CORRECT
      CMA,INA       SET uP
      STA DESPT,I     POSSIBLE NEW STRING LENGTH
      LDB DESPT         THE BLOCK 
      INB                 LENGTH
      LDA 1,I               AND POINT 
      STA TEMP                TO ACTUAL STRING
      ISZ TEMP2 
CRET3 LDB NVFLG     CHECK IF
      CLE,ERB         BASIC NEEDS THIS
      STB NVFLG         VARIABLE
      SEZ,RSS 
      JMP CRE3A     SKIP IF BY VALUE ONLY 
CRE3B JSB EXEC        ELSE WRITE OUT
       DEF *+8
       DEF .20        VALUES
       DEF .0 
       DEF TEMP2,I      TO THE
       DEF DESPT,I
       DEF .0             CLASS 
       DEF .0 
       DEF CLASS
      SPC 1 
      SSA           SUCCESS ? 
      JMP CRE3B     NO, TRY AGAIN 
      SPC 1 
CRE3A JSB RETBF     YES, DEALLOCATE 
       DEF *+2        PARAMETER'S 
       DEF BUFPT,I      BUFFER. 
* 
      LDB DESPT     POINT TO
      ADB M3          THE NEXT
      STB DESPT         DESCRIPTOR
      ISZ BUFPT           AND BUFFER POINTER
CRET4 LDA BUFPT,I   SET UP BUFFER 
      STA TEMP2       ADDRESS 
      ISZ TEMP2     (POINT TO LENGTH WORD)
      ISZ PCNT      MORE PARAMETERS ? 
      JMP CRET1       YES 
      SPC 1 
      CLA           MADE IT, NO ERRORS
CRET6 STA RERR
      LDA DESAD     SEE IF A BUFFER FOR DESCRIPTOR
      SZA,RSS         BLOCK ALLOCATED,
      JMP CRET7     IF SO - 
      JSB RETBF     RETURN BUFFER 
       DEF *+2        FOR DESCRIPTOR
       DEF DESAD        TABLE.
CRET7 JSB CMPK      DO A GARBAGE
       DEF *+1        COLLECT ON MEMORY.
      JSB PRTN      SEND ERROR CODE AND 
       DEF *+2        FLOATED FUNCTION VALUE
       DEF RERR 
      JSB EXEC      TERMINATE 
       DEF *+4        THIS OVERLAY
       DEF .6           AND SAVE RESOURCES
       DEF .0             OR LEAVE IT SERIAL
       DEF #RSFG            RR-USABLE DEPENDING ON FLAG 
      JMP CALSB+1   RETURN TO BEGINNING 
      SPC 2 
NOMEM LDA .1        OUT OF MEMORY 
      STA ABREG       SEND FLAG TO BASIC
* 
      JSB ERROR     PRINT 
      DEF *+3         OUT OF
      DEF .1            MEMORY
      DEF NOMMS           MESSAGE 
* 
      LDB BUFAD     DEALLOCATE
      STB BUFPT       ANY BUFFERS 
NOM1  LDA BUFPT,I       ALLOCATED 
      SZA,RSS             FOR PARAMETERS. 
      JMP NOM2
* 
      JSB RETBF 
       DEF *+2
       DEF BUFPT,I
* 
      ISZ BUFPT 
      JMP NOM1
* 
NOM2  LDA MNEG          SAYING FATAL ERROR
      JMP CRET6 
      SPC 1 
BADXF LDA .2        MISSING RECORD
      JMP NOMEM+1     THIS IS FATAL, TOO
      SKP 
FWAMI BSS 1 
FWPAR BSS 1 
LENTH BSS 1 
DESPT BSS 1 
DESAD BSS 1 
PCNT  BSS 1 
TEMP  BSS 1 
TEMP2 BSS 1 
IERR  BSS 1 
NFLAG BSS 1 
RERR  BSS 1         LEAVE THESE 
ABREG BSS 2         FIVE LOCATIONS IN THIS ORDER
FWAFS BSS 1         FOR RETURN OF PARMETERS 
LWAFS BSS 1         TO BASIC FROM SUBROUTINES 
PADPT EQU ABREG+1 
DBSIZ BSS 1 
RFLAG BSS 1 
FWPWA BSS 1 
BUFAD DEF *+1 
      BSS 15
BUFPT BSS 1 
      SPC 2 
.0    DEC 0 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.6    DEC 6 
.20   DEC 20
.21   DEC 21
.22   DEC 22
.46   DEC 46
MNEG  OCT 100000
M2    DEC -2
M3    DEC -3
M15   DEC -15 
      SPC 2 
PADDR DEF PLIST 
DMMYA DEF ABREG 
AB    ASC 1,AB
NOMMS DEC 9 
      ASC 5,NO MEMORY 
      SPC 5 
      END