
      HED EXECUTION UTILITY ROUTINES
      ORG 44000B
SMSK  OCT 77600 
SERRA ABS -SERRS
RERRA ABS SERRS-RERRS 
FERRA ABS RERRS-FERRS 
WERRA ABS FERRS-WERRS 
DSERR DEF DSERA 
**                             ** 
***  ROUND NUMBER TO INTEGER  *** 
**                             ** 
* 
*  ENTER WITH NUMBER IN (A) AND (B).  EXIT TO (P+2) IF
*  INTEGER FORM (ROUNDED AS NEEDED) IS POSITIVE AND NOT 
*  LARGER THAN 15 BITS, ELSE EXIT TO (P+1).  ON EXIT TO 
*  (P+2), (B) HOLDS THE INTEGER BIASED BY -1. 
* 
#SBFX JSB IFIX      TRUNCATE NUMBER 
      JMP SBFIX,I   NUMBER TOO LARGE
      SZA           INTEGER OVERFLOW? 
      JMP SBFIX,I   YES 
      SEZ,RSS       NO, ROUNDING BIT? 
      ADB .-1       NO, BIAS INTEGER BY -1
      SSB,RSS       YES, POSITIVE RESULT? 
      ISZ SBFIX     YES 
      JMP SBFIX,I   NO
      SKP 
**                         ** 
***  INTEGERIZE A NUMBER  *** 
**                         ** 
* 
*  ENTER WITH A FLOATING POINT NUMBER IN (A) AND (B). 
*  IF EXPONENT EXCEEDS 23, NUMBER HAS INTEGER SIGNIFICANCE; 
*  EXIT TO (P+1).  ALL OTHER CASES EXIT TO (P+2) WITH 32-BIT
*  INTEGER RIGHT JUSTIFIED IN (A) AND (B).  ON EXIT (O) = 0 
*  IF NUMBER IS EXACTLY REPRESENTALE AS A 16-BIT INTEGER.
*  IF EXPONENT IS NEGATIVE, TRUNCATE TO 0 OR -1 APPROPRIATELY 
*  AND LET (O) = 1.  OTHERWISE RIGHT JUSTIFY INTEGER AND EXIT 
*  WITH LAST BIT LOST IN (E). 
* 
#IFIX STA TEMP6     SAVE (A)
      STO           SET 'NOT ONE-WORD INTEGER' MODE 
      JSB .FLUN     UNPACK (B)
      SSA           NEGATIVE EXPONENT?
      JMP IFIX3     YES 
      ADA .-16      NO, EXPONENET 
      SSA             <= 15?
      CLO           YES 
      ADA .-8       NO, EXPONENT
      SSA,RSS         <= 23?
      JMP IFIX,I    NO, ALL SIGNIFICANCE IS INTEGER 
      ADA .-8       YES, MOVE BINARY POINT TO END OF
      STA EXP         (B) AND SAVE SHIFT COUNT
      LDA TEMP6     RETRIEVE (A)
      JMP IFIX2 
IFIX1 CLE,SLA,ARS   SHIFT (A) RIGHT 
      CME           SHIFT 
      SLB,ERB         (B) RIGHT 
      STO           LOST A 1
IFIX2 ISZ EXP       ALL SHIFTS DONE?
      JMP IFIX1     NO
      ISZ IFIX      YES 
      JMP IFIX,I
IFIX3 LDA TEMP6     RETRIEVE (A)
      CLE,SSA       TRUNCATE
      CCA,RSS         TO
      CLA,RSS           -1
      CCB,RSS            OR 
      CLB                   0 
      JMP IFIX3-2 
      SKP 
**                      **
***  REQUEST A RECORD  ***
**                      **
* 
*  UPON ENTRY (A) HOLDS A FILE NUMBER (POSITIVE FOR A READ
*  REQUEST, NEGATIVE FOR A WRITE REQUEST) AND (B) SPECIFIES 
*  VALIDATION OF THE FILE'S EXISTENCE ( (B) = -2) OR THE FILE 
*  RECORD TO BE PUT IN THE FILE BUFFER ( (B) = -1 REQUESTS
*  THE RECORD WHICH FOLLOWS THE ONE CURRENTLY IN THE BUFFER,
*  (B) >= 0 REQUESTS RECORD (B)+1 ).  EXIT TO ERROR IF THE
*  FILE DOES NOT EXIST OR A WRITE REQUEST IS GIVEN FOR A
*  READ-ONLY FILE.  EXIT TO THE END-OF-FILE CODE IF THE 
*  REQUESTED RECORD DOES NOT EXIST.  OTHERWI, THE DIRTY 
*  BIT IS EXAMINED TO DETERMINE IF THE FILE BUFFER SHOULD 
*  BE WRITTEN BACK TO DISC. 
*  A READ REQUEST READS THE REQUESTED RECORD INTO THE BUFFER; 
*  A WRITE REQUEST MERELY INITIALIZES THE BUFFER TO 'EMPTY'.
*  THE FILE TABLE IS UPDATED TO REFLECT THE CHANGES.
* 
#RQST STB RQ2       SAVE RECORD REFERENCE 
      CCB           GET 1'S COMPLEMENT
      SSA             OF FILE NUMBER AND
      CLB,RSS           SET RQ1 = -1 FOR A
      CMA                 READ REQUEST OR 0 
      STB RQ1               FOR A WRITE REQUEST 
      ADA FCNTR     DOES REQUESTED
      CMA,SSA,RSS     FILE EXIST? 
      JSB RERRS+35,I  NO
      ADA FCNTR     YES 
      MPY .+FTEL    SET POINTER 
      ADA FILTB       TO FILE TABLE 
      STA FBASE         ENTRY 
      LDA FBASE,I   LOAD NUMBER OF RECORDS
      SZA,RSS       DOES FILE EXIST?
      JSB RERRS+35,I
      LDB FBASE 
      ADB .+4 
      STB FBASE 
      CCB,CLE 
      SSA           READ-ONLY FILE? 
      CPB RQ1       YES, READ REQUEST?
      ELA,CLE,SLA,ERA    YES, CLEAR BIT 15 AND SKIP 
      JSB RERRS+36,I  NO
      LDB RQ2       FILE VALIDATION 
      CPB .-2         ONLY? 
      JMP RQST9     YES 
      ISZ RQ2       NO, RECORD SPECIFIED? 
      JMP RQST2     YES 
      LDB FBASE,I   NO, GET HIGH OLD RECORD ADDRESS 
      CPB BIT15     NULL RECORD?
      JMP RQST6     YES 
      ISZ FBASE     NO, COMPUTE 
      LDB FBASE,I     RECORD'S
      ISZ FBASE         DISTANCE
      ISZ FBASE           FROM
      CMB                   FIRST 
      ADB FBASE,I             RECORD
      CMB 
      LDA .-7       GET RECORD
      ADA FBASE       COUNT BACK
      LDA A,I           INTO A
      ELA,CLE,ERA   CLEAR BIT 15
      SLB 
      ADB A 
      CLE,ERB 
      INB             NUMBER
      JMP RQST7 
RQST6 CLB           NO RECORD IN CORE 
RQST2 ISZ FBASE     ADJUST POINTER
      ISZ FBASE       TO LOW WORD 
      ISZ FBASE         OF BASE ADDRESS 
RQST7 CMA,INA       DOES
      ADA 1           RECORD
      SSA               EXIST?
      JMP *+4       YES 
      ISZ FBASE     NO, CORRECT FBASE 
      ISZ FBASE 
      JMP FDT4A,I     FOR EOF EXIT CHECK
      ADA 1 
      IOR .+1       COMPUTE RELATIVE
      BLS             DISC
      SSA               ADDRESS 
      LDA 1               OF NEW RECORD 
      CCB           GET HIGH
      ADB FBASE       DISC
      LDB B,I           ADDRESS 
      CLE 
      ADA FBASE,I   COMPUTE LOW DISC ADDRESS
      STA RQ2       SAVE IT 
      SEZ           INCREMENT IF
      INB             CARRY FROM
      STB RQ4           LOW ADD 
      LDB .-6       GET 
      ADB FBASE       NEGATIVE
      LDB B,I           OF BUFFER 
      BLR,RBR 
      CMB,INB             SIZE
      STB RQ5       SAVE IT 
      ISZ FBASE     SET POINTER 
      ADB FBASE,I     TO BEGINNING
      ISZ FBASE 
      STB FBASE,I       OF RECORD BUFFER
      STB RQ3       SAVE ADDRESS OF BUFFER
      LDB FBASE     MOVE TO 
      ADB .-4         DISC
      STB FBASE         ADDRESSES 
      ADB .-1       IS ANY
      LDB B,I         RECORD
      CPB BIT15         IN CORE?
      JMP RQS15     NO, SKIP COMPARE AND WRITE
      CPA FBASE,I   OLD AND NEW RECORDS THE SAME? 
      JMP RQST3     YES 
      JSB WRBUF     NO, WRITE OLD RECORD TO DISC
RQS15 EQU * 
      ISZ RQ1       READ REQUEST? 
      JMP RQST4     NO
      LDB RQ5       GET NEGATIVE BUFFER SIZE
      CLF 0 
      LDA .+3       GET ADDRESS 
      ADA ERSCA       OF DOUBLE WORD ADDRESS
      STB MWORD     STORE WORD COUNT
      LDB RQ3       GET CORE ADDRESS
      ADB BIT15       AND READ BIT
      JSB DISCA,I   READ
      HLT DEATH+30B   IN
      HLT DEATH+31B     REQUESTED 
      LDA MBUSY           RECORD
      SSA 
      JMP *-2 
      SZA,RSS       SKIP ON ERROR 
      JMP RQST5 
      JSB RERRS+45,I GO INDICATE ERROR
RQST3 ISZ RQ1       WRITE REQUEST?
      RSS           YES 
      JMP RQS14     NO, GO FINISH UP
RQST4 LDB EOR       SCRATCH RECORD
      STB RQ3,I       WITH END-OF-RECORD MARK 
      JMP RQS14     GO FINISH UP
RQST5 LDB FBASE     GET 
      ADB .+9         PROTECT 
      LDA B,I           MASK
      SZA,RSS       IS IT ZERO? 
      JMP RQS14     YES, SKIP MASKING 
      STA PMASK     NO, SAVE MASK 
      ADB .-6       ADJUST FBASE TO 
      STB FBASE       BUFFER LIMIT POINTER
      LDB RQ3 
RQS11 CPB FBASE,I   DONE ?
      JMP RQS13     YES 
      LDA 1,I       NO
      CPA EOR        EOR ?
      JMP RQS13 
      CPA EOF        EOF ?
      JMP RQS13 
      AND M256
      CPA B1000      STRING ? 
      JMP *+3 
      ADB .+2        SKIP TWO WORDS 
      JMP RQS11 
      LDA 1,I        YES
      AND B377
      ADA .+3 
      ARS 
      ADA 1 
      STA ATMP
RQS12 INB           MASK
      CPB ATMP
      JMP RQS11       STRING
      LDA 1,I 
      XOR PMASK 
      STA 1,I 
      JMP RQS12 
RQS13 LDA FBASE     RESTORE 
      ADA .-3 
      STA FBASE      FBASE
RQS14 EQU * 
      LDA RQ2 
      STA FBASE,I     NEW RECORD INTO FILE TABLE
      LDA RQ4 
      CCB 
      ADB FBASE 
      STB FBASE 
      STA B,I 
RQST9 LDB FBASE     MOVE POINTER
      ADB .+5         TO REFERENCE
      STB FBASE         RECORD POINTER
      JMP RQSTR,I 
      SKP 
**                        **
*** STORE ITEM IN FILE  *** 
**                        **
* 
*  UPON ENTRY (B) INDICATES WHAT IS TO BE WRITTEN ON THE FILE:
*  (B) = -1 WRITES AN END-OF-FILE MARK, (B) = -2 WRITES A TWO-
*  WORD FLOATING POINT NUMBER, (B) = -3 WRITES A STRING.  IF
*  THE RECORD CANNOT ACCOMMODATE THE QUANTITY, A SERIAL WRITE 
*  WILL PLACE IT IN THE FOLLOWING RECORD WHILE A RECORD WRITE 
*  WILL EXIT TO THE END-OF-FILE CODE. 
* 
#FILS STB FILT      SAVE REQUEST TYPE 
      LDB FBASE     GET 
      ADB .+5         PROTECT 
      LDB 1,I           MASK
      STB PMASK 
      CCB           LOAD
      ADB FBASE       ACTIVE AND LIMIT
      DLD 1,I           RECORD POINTERS 
      CPA 1         RECORD FULL?
      JMP FILS1     YES 
      STB DADRR     NO, SAVE ACTIVE POINTER 
      ISZ FILT      EOF REQUEST?
      JMP FILS2     NO
      CCA           YES,OVERLAY PREVIOUS
      STA 1,I         EOR OR EOF WITH EOF MARK
FILS7 LDB FBASE     MAKE POINTER TO SECOND WORD OF
      ADB .-8         FILE TABLE ENTRY. 
      LDA B,I       SET BUFFER
      IOR BIT15       DIRTY 
      STA 1,I           BIT.
      JMP FILST,I 
FILS2 ISZ FILT      STRING? 
      JMP FILS6     YES 
      ADB .+2       NO
FILS3 CMA,INA       COMPARE PROSPECTIVE 
      ADA 1           ACTIVE POINTER WITH 
      CMA,INA           END-OF-RECORD POINTER 
      SSA           OVERFLOW? 
      JMP FILS0     YES 
      STB FBASE,I   NO, SAVE NEW ACTIVE POINTER 
      SZA,RSS       RECORD EXACTLY FULL?
      JMP FILS4     YES 
      LDA EOR       NO, FOLLOW ENTRY SPACE
      STA 1,I         WITH EOR MARK 
FILS4 ISZ FILT      STRING? 
      JMP FILS5     NO
      LDA TNULL     YES 
      CMA           COMPUTE AND 
      IOR B1000       STORE STRING
      STA DADRR,I       HEADER WORD 
      LDA FSCHA     TRANSFER
      JSB TRSTR       STRING
      JMP FILS7 
FILS5 DLD SBPTR,I   TRANSFER
      SZA,RSS       ZEROS ARE 
      JMP FIL5A       NOT MASKED
      XOR PMASK     MASK
      SWP 
      XOR PMASK      DATA 
      SWP 
FIL5A DST DADRR,I     NUMBER
      JMP FILS7 
FILS6 INB           COMPUTE 
      BLS             DESTINATION 
      STB TEMP5         ADDRESS 
      CMB,INB       COMPUTE 
      ADB TNULL       RECORD
      CMB,INB           SPACE 
      BRS                 REQUIRED
      JMP FILS3 
FILS0 LDA EOR       INSURE EOR MARK 
      STA DADRR,I     ENDS PRESENT RECORD 
      LDA .-2       RESTORE 
      ADA FILT       REQUEST
      STA FILT        TYPE
FILS1 CCB 
      CPB RCRD#     SERIAL WRITE? 
      RSS           YES 
      JMP FDT4A,I   NO
      LDA FILE#     REQUEST 
      CMA             RECORD
      JSB RQSTR         TO WRITE
      JMP #FILS+1 
**                             ** 
***  GET NEXT FILE ITEM TYPE  *** 
**                             ** 
* 
*  THE NEXT ITEM IN THE FILE, NUMBER, STRING, END-OF-FILE, OR 
*  END-OF-RECORD, IS IDENTIFIED AND UPON EXIT (A) =1,2,3, OR 4
*  RESPECTIVELY.  EORFL = -1 WILL IGNORE END-OF-RECORD'S AND
*  RETURN WITH THE FIRST OF THE OTHER ITEMS ENCOUNTERED.
* 
GTTY0 CCB 
GTTY1 LDA FILE#     REQUEST 
      JSB RQSTR       NEXT RECORD 
#GTTY CCB           LOAD ACTIVE 
      ADB FBASE       AND LIMIT 
      DLD 1,I           RECORD POINTERS 
      CPA 1         PHYSICAL END OF RECORD? 
      JMP GTTY3     YES 
      LDA 1,I       NO, LOAD WORD 
      CLB,INB         OF RECORD 
      CPA EOR       END-OF-RECORD?
      JMP GTTY3     YES 
      CPA EOF       NO, END-OF-FILE?
      JMP GTTY4     YES 
      AND M256      NO
      CPA B1000     STRING? 
      INB           YES, (B) = 2
GTTY2 LDA 1         SET (A) = (B) 
      JMP GTTYP,I 
GTTY3 LDB FBASE     PHYSICAL
      ADB .-5       NULL RECORD 
      LDA B,I 
      CPA BIT15       IN CORE?
      JMP GTTY0     YES 
      ADB .-1       NO, PHYSICAL
      LDA B,I         END 
      ADB .+2           OF
      CPA B,I             FILE? 
      JMP GTTY5     YES 
      CCB           NO
      CPB EORFL     EOR'S WANTED? 
      JMP GTTY1     NO
      LDB .+2       YES, SET (B) = 4
GTTY4 ADB .+2       (B) = (B) + 2 
      JMP GTTY2 
GTTY5 LDA .+3       (A) = 3 
      JMP GTTYP,I 
**                          **
***  WRITE BUFFER TO DISC  ***
**                          **
* 
*  THE BUFFER OF THAT FILE CURRENTLY REFERENCED BY FBASE IS 
*  WRITTEN TO ITS PLACE ON THE DISC, UNLESS NOTHING HAS BEEN
*  WRITTEN INTO THE BUFFER. 
* 
#WRBU LDB FBASE     LOAD SECOND 
      ADB .-4         WORD FROM 
      LDA B,I           FILE TABLE
      ELA                 ENTRY (RECORD LENGTH) 
      SEZ,CLE,RSS   HAS BIT 15 BEEN SET?
      JMP WRBUF,I   NO
      ERA           YES, CLEAR IT 
      STA B,I       STORE IT BACK 
      ADB .+3       GET HIGH CURRENT
      LDA B,I         RECORD ADDRESS
      CPA BIT15     NULL RECORD?
      JMP WRBUF,I   YES, DON'T WRITE RECORD OUT 
      ADB .+10      GET 
      LDA B,I         PROTECT MASK
      SZA,RSS       IS IT ZERO? 
      JMP WRBU7     YES, SKIP STRING MASKING
      STA PMASK     NO, SAVE MASK 
      ADB .-6       ADJUST FBASE TO 
      STB FBASE       BUFFER LIMIT POINTER
      LDB RQ3 
WRBU4 CPB FBASE,I    DONE ? 
      JMP WRBU6 
      LDA 1,I       NO
      CPA EOR        EOR ?
      JMP WRBU6 
      CPA EOF        EOF ?
      JMP WRBU6 
      AND M256
      CPA B1000      STRING ? 
      JMP *+3 
      ADB .+2        SKIP TWO WORDS 
      JMP WRBU4 
      LDA 1,I        YES
      AND B377
      ADA .+3 
      ARS 
      ADA 1 
      STA ATMP
WRBU5 INB 
      CPB ATMP
      JMP WRBU4 
      LDA 1,I 
      XOR PMASK 
      STA 1,I 
      JMP WRBU5 
WRBU6 LDB FBASE 
      ADB .-3 
      STB FBASE 
      ADB .+9       => PMASK WORD 
WRBU7 ADB .-13      => WORDS/RECORD WORD
      LDA B,I 
      IOR BIT14     SET FILE
      STA B,I         DIRTY BIT 
      ALR,RAR       CLEAR DIRTY BITS AND
      CMA,INA         GET NEG. REC. LENGTH
      CLF 0 
      STA MWORD     WRITE 
      LDB RQ3 
      CCA             RECORD
      ADA FBASE 
      JSB DISCA,I       TO
      HLT DEATH+30B 
      HLT DEATH+31B       DISC
      LDA MBUSY 
      SSA 
      JMP *-2 
      SZA,RSS       SKIP ON ERROR 
      JMP WRBUF,I 
      JSB RERRS+46,I GO INDICATE ERROR
**                       ** 
***  TRANSFER A STRING  *** 
**                       ** 
* 
*  THE NUMBER OF CHARACTERS SPECIFIED BY TNULL (IN 1'S
*  COMPLEMENT) IS TRANSFERRED FROM THE SOURCE STRING TO 
*  A DESTINATION STRING BEGINNING WITH THE CHARACTER
*  ADDRESSED BY TEMP5.
* 
#TRST STA TRFCH     SAVE SUBROUTINE CALL
      ISZ TNULL     MORE TRANSFER STRING? 
      RSS           YES 
      JMP TRSTR,I   NO
      JSB TRFCH,I   FETCH A SOURCE CHARACTER
      LDA .+40B     NONE LEFT, LOAD A BLANK 
      STA TRS0      SAVE IT 
      LDB TEMP5     LOAD
      CLE,ERB         DESTINATION 
      LDA B,I           WORD
      SEZ,RSS       SAVE
      ALF,ALF         OTHER 
      AND M256          CHARACTER 
      IOR TRS0      COMBINE WITH
      SEZ,RSS         NEW CHARACTER 
      ALF,ALF           AND STORE 
      STA 1,I             WORD
      ISZ TEMP5     INCREMENT DESTINATION ADDRESS 
      JMP #TRST+1 
      HED ARITHMETIC SUBROUTINES
**
***   ADD TWO FLOATING POINT NUMBERS
**
#FAD  STA A1         SET POINTER TO 2ND ARGUMENT. 
      LDA .FAD,I
      STA A2
      LDA A1
      FAD A2,I                                   [B]
      ISZ .FAD       SET RETURN ADDRESS.
      SOC 
      JSB OUCHK      OVERFLOW OR UNDERFLOW! 
      JMP .FAD,I     RETURN.
**
***   SUBTRACT TWO FLOATING POINT NUMBERS 
**
#FSB  STA A1         SET POINTER TO 2ND ARGUMENT. 
      LDA .FSB,I
      STA A2
      LDA A1
      FSB A2,I                                   [B]
      ISZ .FSB       SET RETURN ADDRESS.
      SOC 
      JSB OUCHK      OVERFLOW OR UNDERFLOW! 
      JMP .FSB,I     RETURN.
**
***   DETERMINES IF OVERFLOW OR UNDERFLOW 
***   MESSAGE HAS TO BE GIVEN.
**
#OUCK STA A1         SAVE REGISTERS.
      STB A2
      SZA            OVER- OR UNDERFLOW?
      JMP OUCK2 
      JSB CHOUF      UNDERFLOW! CHECK STATUS. 
      JSB WERRS+6,I 
OUCK1 EQU * 
      LDA A1         RE-INSTATE REGISTERS.
      LDB A2
      JMP OUCHK,I    RETURN.
OUCK2 EQU * 
      JSB CHOUF      OVERFLOW! CHECK STATUS.
      JSB WERRS+5,I 
      JMP OUCK1 
**
**                                         ** 
***  MULTIPLY TWO FLOATING POINT NUMBERS  *** 
**                                         ** 
#FMP  STA A1         SET POINTER TO 2ND ARGUMENT
      LDA .FMP,I
      STA A2
      LDA A1
      FMP A2,I                                   [B]
      ISZ .FMP       SET RETURN ADDRESS.
      SOC 
      JSB OUCHK      OVERFLOW OR UNDERFLOW! 
      JMP .FMP,I     RETURN.
**
***   DIVIDE TWO FLOATING POINT NUMBERS 
**
#FDV  STA A1         SET POINTER TO 2ND ARGUMENT
      LDA .FDV,I
      STA A2
      LDA A1
      FDV A2,I                                   [B]
      ISZ .FDV       SET RETURN ADDRESS.
      SOC 
      JSB OUCHK      OVERFLOW OR UNDERFLOW! 
      JMP .FDV,I     RETURN.
**                             ** 
***  TAKE ARITHMETIC INVERSE  *** 
**                             ** 
* 
*  ENTER WITH A FLOATING POINT NUMBER IN (A) ABD (B). 
*  EXIT WITH ITS ARITHMETIC INVERSE IN (A) AND (B). 
* 
#ARIN DST C1         STORE NUMBER.
      CLA            A=0. 
      CLB            B=0. 
      FSB C1                                     [B]
      JMP ARINV,I 
**                               ** 
***  UNPACK LOW WORD OF NUMBER  *** 
**                               ** 
* 
*  ENTER WITH LOW WORD OF FLOATING POINT NUMBER IN (B). 
*  EXIT WITH EXPONENT IN (A) AND MANTISSA IN (B). 
* 
#FLUN CLA           EXTRACT 
      LSR 8           EXPONENT
      ALF,ALF           IN (A) AND
      BLF,BLF             MANTISSA IN (B) 
      SLA,RAR       NEGATIVE EXPONENT?
      IOR SMSK      YES, FILL IN LEADING BITS 
      JMP .FLUN,I   NO
