*DECK  FMHLPRS
          IDENT  FMHLPRS
 FMHLPRS  TITLE  FORM COMPASS HELPERS.  BASE OVERLAY UTILITIES
          SPACE  4
**
*   MACROS
* 
 PASSLOC  MACRO  ENDPASS     BUILD PASSLOC TABLE FOR LOADER 
 +        VFD    12/24B,12/ENDPASS-*-1,36/0 
 PASSMIC  MICRO  1,,//
          ENDM
* 
 PLC      MACRO  NAME 
          IFC    GE,/"PASSMIC"/NAME/,1
 P        ERR    NAME OUT OF SEQUENCE AFTER "PASSMIC" 
          VFD    42/0L_NAME,18/0
          VFD    42/0,18/=Y_NAME
 PASSMIC  MICRO  1,,/NAME/
          ENDM
* 
 PLX      MACRO  NAME 
          EXT    NAME 
          PLC    NAME 
          ENDM
          SPACE  4
 ENTRTAB  MACRO  ENDENTR     BUILD ENTRY TABLE FOR LOADER 
 +        VFD    12/21B,12/ENDENTR-*-1,36/0 
 ENTRMIC  MICRO  1,,//
          ENDM
* 
 LINK     MACRO  NAME        LINKAGE POINT TO CAPSULE ENTRY 
          IFC    GE,/"ENTRMIC"/NAME/,1
 P        ERR    NAME OUT OF SEQUENCE AFTER "ENTRMIC" 
          ENTRY  NAME 
 NAME     VFD    42/0L_NAME,18/0
 ENTRMIC  MICRO  1,,/NAME/
          ENDM
* 
 PASS     MACRO  NAME        PASS ENTRY TO CAPSULE EXTERNAL 
          IFC    GE,/"ENTRMIC"/NAME/,1
 P        ERR    NAME OUT OF SEQUENCE 
          VFD    42/0L_NAME,18/=Y_NAME
 ENTRMIC  MICRO  1,,/NAME/
          ENDM
          EJECT 
 FM$LUSR  TITLE  FM$LUSR - LOAD USER OWNCODE PROGRAMS 
          ENTRY  FM$LUSR,FM$OWN,FM$UENT,FM$MAXU 
**
*  FM$LUSR - LOADS USER OWNCODE ROUTINES
* 
*  CALL  -  FM$LUSR.  AFTER SETTING UP ENTRY TABLE
* 
          SPACE  2
 FM$LUSR  JP     *+1S17 
          LOADER  LODPARM,CMM 
          SA1    LODPARM+2         RETURN STATUS
          BX7    -X7-X7 
          LX6    X1 
          EQ     FM$LUSR
          SPACE  4
 LODPARM  LDREQ  BEGIN
          LDREQ  MAP,N
 +        VFD    12/00B,12/1,36/1  LDREQ LOAD,(FILE)
 FM$OWN   DATA   0                 FILE NAME GOES HERE
 LOCS     PASSLOC  ENDLOCS
          PLC    CLL$RM 
          PLC    CLOF$RM
          PLX    CLOSEM 
          PLC    CLOV$RM
          PLC    CMM.AGR
          PLX    CMM.ALF
          PLX    CMM.CSF
          PLC    CMM.DOE
          PLC    CMM.FGR
          PLC    CMM.FRF
          PLX    CMM.GLF
          PLC    CMM.GSS
          PLC    CMM.OP1
          PLC    CMM.OP2
          PLC    CMM.OP4
          PLC    CMM.POE
          PLC    CMM.SFF
          PLC    CMM.SLF
          PLC    DLT$RM 
          PLX    ENDFILE
          PLC    ERR$RM 
          PLX    FDL.LDC
          PLX    FDL.ULC
          PLC    FLSH$RM
          PLX    GET
          PLX    GETFIT.
          PLX    GETN 
          PLC    GETN$RM
          PLX    GETP$RM
          PLC    GET$RM 
          PLC    GTL$RM 
          PLC    GTNR$RM
          PLX    IFETCH 
          PLX    LOF$RM 
          PLX    MSG= 
          PLX    OPENM
          PLC    OPNM$RM
          PLC    PTL$RM 
          PLX    PUT
          PLC    PUTP$RM
          PLC    PUT$RM 
          PLC    REPL$RM
          PLC    REW$RM 
          PLC    SEEK$RM
          PLC    SFIT$RM
          PLX    STOREF 
          PLC    STRT$RM
          PLX    SYMHBR.
          PLX    SYMSC$ 
          PLX    SYMSG$ 
          PLX    SYMSM$ 
          PLX    SYS= 
          PLX    UGTFIT.
          PLC    WEOP$RM
          PLX    WEOR 
          PLC    WEOS$RM
          PLC    WMK$RM 
 ENDLOCS  BSS    0
          LDREQ  SATISFY
 FM$UENT  ENTRTAB  ENDENT    USER ENTRIES 
          BSSZ   50 
 ENDENT   BSS    0
          LDREQ  NOGO 
          LDREQ  END
* 
          SPACE  2
 FM$MAXU  DATA   50D         MAXIMUM NUMBER OF USER ENTRIES 
          EJECT 
 FM$LIST  TITLE  FM$LIST / FM$PASS -- FDL PARAMETER AND LINKAGE LISTS 
          ENTRY  FM$LIST,FM$PASS
**
**  FM$LIST - CAPSULE LIBRARY LIST
* 
 FM$LIST  DATA   0LBIT8LIB   CAPSULE LIBRARY FOR FORM/8-BIT 
          DATA   0
          SPACE  4
**
*  FM$PASS - ENTRY POINT LINKAGES BETWEEN OVERLAY AND CAPSULES
* 
 FM$PASS  VFD    42/0,18/LOCS      GENERAL ENTRIES
          VFD    42/0,18/FLIST     FORM-SPECIFIC ENTRIES
          DATA   0
          SPACE  2
 FLIST    ENTRTAB  ENDFL
          PASS   CLOSEM 
          PASS   CMM$ALF
          PASS   CMM$CSF
          PASS   CMM$FRF
          PASS   CMM$GLF
          PASS   ENDFILE
          PASS   FDL$LDC
          PASS   FDL$ULC
          PASS   FM$ABRT
          PASS   FM$AKEY
          PASS   FM$BFNC
          PASS   FM$CALL
          PASS   FM$COMM
          LINK   FM$CRAK
          PASS   FM$DAYF
          PASS   FM$ERR 
          PASS   FM$ERXT
          PASS   FM$FDB 
          PASS   FM$FILL
          PASS   FM$FUNC
        PASS    FM$GET
        PASS    FM$GETN 
          PASS   FM$IFDB
          PASS   FM$IFNC
          PASS   FM$LFDB
          PASS   FM$LIST
          PASS   FM$LUSR
          PASS   FM$MAXU
          PASS   FM$MEMR
          PASS   FM$MOVW
          PASS   FM$OWN 
          PASS   FM$PASS
          PASS   FM$PKEY
          PASS   FM$PKYA
        PASS    FM$PUT
          PASS   FM$RFNC
          LINK   FM$RUN 
          PASS   FM$SKPP
          PASS   FM$SKPR
          PASS   FM$SKPS
          LINK   FM$STAT
          PASS   FM$UENT
          PASS   FM$XWRT
          LINK   XWRITE 
 ENDFL    BSSZ   1
          EJECT 
 FM$CALL  TITLE  FM$CALL - PERFORM INDIRECT CALLING THROUGH ENTRY TABLE 
**
*  FM$CALL (PROC, PARAMS,...)  PERFORMS INDIRECT CALL THROUGH ENTRY 
*                              TABLES. FOR LINKING FROM MAIN TO CAPSULES
* 
          ENTRY  FM$CALL,FM$FUNC,FM$IFNC,FM$RFNC,FM$BFNC
 FM$CALL  JP     *+1S17 
 FM$FUNC  EQU    FM$CALL
 FM$IFNC  EQU    FM$CALL
 FM$RFNC  EQU    FM$CALL
 FM$BFNC  EQU    FM$CALL
* 
          SA3    FM$CALL     RETURN WORD
          SA2    X1          PROC ENTRY TABLE ADDRESS 
          BX6    X3 
          SA1    A1+1        ADVANCE PARAMETER LIST POINTER 
 FMCALL   SB6    X2 
          SA6    X2          STORE RETURN 
          RJ     FMCALL1     VOID INSTRUCTION STACK 
 FMCALL1  BSS    1
          JP     B6+1        CALL ROUTINE 
* 
          SPACE  4
**
*  FM$XWRT (WSA, REF(RECORD), CON)  CALLS XWRITE AFTER DEREFRENCING THE 
*                                   RECORD.  REF(RECORD) CONTAINS A 
*                                   COBOL TYPE RECORD DESCRIPTOR
          ENTRY  FM$XWRT
 FM$XWRT  JP     *+1S17 
          SB1    1
          BX7    X1          WSA ADDRESS
          SA2    A1+B1       RECORD REFERENCE 
          SA7    FMX.P       PARAMETER AREA 
          SA3    X2 
          SA4    A2+B1       CONVERSION STRING POINTER
          BX6    X3          DE-REFERENCED RECORD ADDRESS 
          SA3    FM$XWRT
          SA6    A7+B1
          SA2    XWRITE      LOCAL LINK 
          SA1    A7 
          BX7    X4 
          BX6    X3 
          SA7    A6+B1
          EQ     FMCALL 
* 
 FMX.P    BSSZ   4           PARAMETER AREA 
          SPACE  4,10 
**        FM$DAYF - OUTPUT DAYFILE MESSAGE. 
* 
*         FM$DAYF(MESSAGE)
* 
*         ENTRY  MESSAGE = HOLLERITH STRING WITH ZERO BYTE TERMINATOR.
* 
*         EXIT   MESSAGE PRINTED. 
* 
*         CALLS  MSG=.
  
  
          ENTRY  FM$DAYF
  
 FM$DAYF  EQ     *+1S17      ENTRY/EXIT 
          SB1    1           ALWAYS 
          SB2    X1          SINCE X1 GETS CLOBBERED
          MESSAGE B2,,RCL    ISSUE MESSAGE
          EQ     FM$DAYF     RETURN 
  
        TITLE   UTILITY AND MISCELLANEOUS INTERFACE ROUTINES. 
          SPACE  4
**
*  FM$EXIT / FM$ABRT  - PERFORM ENDRUN AND ABORT ACTIONS
* 
          ENTRY  FM$EXIT
 FM$EXIT  JP     *+1S17 
 EXIT.    ENDRUN
          JP     EXIT.
* 
          SPACE  2
* 
          ENTRY  FM$ABRT
 FM$ABRT  JP     *+1S17 
          CLOSEM  FM$LFDB,N        FLUSH ERROR MESSAGES 
 ABRT.    ABORT  ,ND         ABORT WITH NO DMPX 
  
          JP     ABRT.
* 
          SPACE  2
* 
          ENTRY  FM$ERXT
 FM$ERXT  JP     *+1S17      CRM GENERAL ERROR EXIT ROUTINE 
          FETCH  A0,FNF,X5
          MI     X5,FATAL          IF FATAL CRM ERROR 
          FETCH  A0,ES,X5 
          SB5    X5-140B
          NZ     B5,FM$ERXT        IF NOT WRITE PARITY ERROR, OK
 FATAL    BSS    0
          SA1    ERXT.P 
          RJ     FM$ERR 
* 
 ERXT.P   CON    =0          ERROR PARAMETER LIST 
          CON    =-1         DLOC 
          CON    ERXT.T 
          CON    =0          TYPE 
          CON    =-2
          CON    0
* 
 ERXT.T   DATA  20HFATAL CRM ERROR    : 
        SPACE   4,10
**
*     FM$FILL( DESTINATION, VALUE, WORD-COUNT );
* 
*             FILL A SEQUENCE OF WORD-COUNT CONTIGUOUS WORDS
*             BEGINNING AT DESTINATION WITH VALUE.
* 
          ENTRY  FM$FILL
 FM$FILL  EQ     *+1S17      ENTRY/EXIT 
          SB1    1           B1=1 
        SB2     X1      (B2) = NEXT WORD TO SET 
        SA1     A1+B1 
        SA2     X1
        BX6     X2      (X6) = WORD TO STORE
        BX7     X2      (X7) = SAME 
        SA1     A1+B1 
        SA1     X1      (X1) = WORD COUNT 
        BX2     X1      (X2) = SAVED WORD COUNT 
        AX1     1       (X1) = LOOP COUNT 
        SB3     X2+B2   (B3) = LWA + 1 OF USERS AREA
        ZR      X1,FM$FILL2     IF 1 OR 0 WORDS 
        SB3     B3-1    (B3) = LWA OF USERS AREA
 FM$FILL1       SA6     B2
        SA7     A6+B1 
        SB2     A7+1
        LT      B2,B3,FM$FILL1  IF MORE TO DO 
 FM$FILL2       LX2     -1
        PL      X2,FM$FILL      IF EVEN WORD COUNT, RETURN
        SA6     B2      SET LAST WORD 
        EQ      FM$FILL RETURN
        SPACE   4,10
**
*     FM$MOVW( DESTINATION, SOURCE, WORD-COUNT ); 
* 
*             MOVE WORD-COUNT CONTIGUOUS WORDS
*             FROM SOURCE TO DESTINATION. 
* 
          ENTRY  FM$MOVW
 FM$MOVW  EQ     *+1S17      ENTRY/EXIT 
        SB1     1       ALWAYS
        SX3     X1      (X3) = DESTINATION ADDRESS
        SA2     A1+B1   (X2) = SOURCE ADDRESS 
        SA1     A2+B1 
        SA1     X1      (X1) = WORD COUNT 
        RJ      =XMVE=  MOVE THE BLOCK
* 
*  SET B7 TO ZERO TO AVOID A BUG IN THE 8-BIT ROUTINES CONCERNING THE 
*  WAY THE B-REGISTERS ARE SAVED AND RESTORED.  THIS CODE IS UNNECESSARY
*  IF THE BUG IN THE 8-BIT ROUTINES IS FIXED. 
* 
          SB7    0           AVOID BUG IN 8-BIT ROUTINES
        EQ      FM$MOVW RETURN
        TITLE   FILE POSITIONING ROUTINES.
 FM$SKPP  EJECT  FM$SKPP - POSITION INPUT FILES 
**
*  FM$SKPP (FDB, POSITION)   SKIP "POSITION" PARTITIONS 
*                              FORWARD IF POSITION GR 0 
*                              BACKWARD IF POSITION LS 0
* 
          ENTRY  FM$SKPP
 FM$SKPP    JP   *+1S17 
* 
          SA0    X1          ADDRESS OF FIT 
          SA1    A1+1 
          SA1    X1          COUNT
          ZR     X1,FM$SKPP  ZERO 
          NG     X1,FM$SK.1  BACKWARD 
          SKIPFF  A0,X1 
          EQ     FM$SKPP
* 
 FM$SK.1  BX1    -X1
          SKIPBF  A0,X1 
          EQ     FM$SKPP
 FM$SKPR  SPACE  4,10 
**        FM$SKPR(FDB,POS) - SKIP RECORDS ON A FILE.
* 
*         ENTRY  FDB = FIT FOR FILE.
*                POS = VALUE FROM POS= OF INP DIRECTIVE.
  
  
          ENTRY  FM$SKPR
 FM$SKPR  EQ     *+1S17      ENTRY/EXIT 
          SA0    X1          (A0) = FIT ADDRESS 
          SA1    A1+1 
          SA1    X1          (X1) = COUNT 
          ZR     X1,FM$SKPR  IF ZERO
          MI     X1,FM$SKPR1 IF BACKWARD SKIP 
          SKIPFL A0,X1       POSITION FORWARD 
          EQ     FM$SKPR     RETURN 
  
 FM$SKPR1 BX1    -X1         (X1) = ABS(COUNT)
          SKIPBL A0,X1       POSITION BACKWARD
          EQ     FM$SKPR     RETURN 
 FM$SKPS  SPACE  4,10 
**        FM$SKPS(FDB,POS) - SKIP SECTIONS ON A FILE. 
* 
*         ENTRY  FDB = FIT FOR FILE.
*                POS = VALUE FROM POS= OF INP DIRECTIVE.
  
  
          ENTRY  FM$SKPS
 FM$SKPS  EQ     *+1S17      ENTRY/EXIT 
          SA0    X1          (A0) = FIT ADDRESS 
          SA1    A1+1 
          SA1    X1          (X1) = COUNT 
          ZR     X1,FM$SKPS  IF ZERO
          MI     X1,FM$SKPS1 IF BACKWARD SKIP 
          SKIPFP A0,X1       POSITION FORWARD 
          EQ     FM$SKPS     RETURN 
  
 FM$SKPS1 BX1    -X1         (X1) = ABS(COUNT)
          SKIPBP A0,X1       POSITION BACKWARD
          EQ     FM$SKPS     RETURN 
  
        TITLE   SPECIAL CRM FUNCTIONS FOR FM$RUN MAIN LOOP. 
 FM$GET SPACE   4,10
**      FM$GET - GET A RECORD FOR FM$RUN MAIN LOOP. 
* 
*       PROC FM$GET;
*       FM$GET(FDB,WSA);
* 
*       ENTRY   FDB = FIT ARRAY.
* 
*       EXIT    WSA = RECORD FROM FILE. 
* 
*       CALLS   GET$RM. 
  
  
        ENTRY   FM$GET
  
 FM$GET EQ      *+1S17  ENTRY/EXIT
        SX6     A0
        SA6     FM$GETA SAVE (A0) 
        SA0     X1      (A0) = FIT ADDRESS
        SB1     1       (B1) := 1 
        SA1     A1+B1   (X1) = WSA ADDRESS
        GET     A0,X1   READ THE RECORD 
        SA1     FM$GETA 
        SA0     X1      RESTORE (A0)
        EQ      FM$GET  RETURN
  
 FM$GETA        BSS     1       SAVE CELL FOR (A0)
 FM$GETN        SPACE   4,10
**      FM$GETN - GET NEXT RECORD FOR FM$RUN MAIN LOOP. 
* 
*       PROC FM$GETN; 
*       FM$GETN(FDB,WSA,KEY); 
* 
*       ENTRY   FDB = FIT ARRAY.
* 
*       EXIT    WSA = RECORD FROM FILE. 
*               KEY = KEY FOR THIS RECORD.
* 
*       CALLS   GETN$RM.
  
  
        ENTRY   FM$GETN 
  
 FM$GETN        EQ      *+1S17  ENTRY/EXIT
        SX6     A0
        SA6     FM$GETNA        SAVE (A0) 
        SA0     X1      (A0) = FIT ADDRESS
        SB1     1       (B1) := 1 
        SA1     A1+B1   (X1) = WSA ADDRESS
        SA2     A1+B1   (X2) = KEY ADDRESS
        GETN    A0,X1,,X2       READ THE RECORD 
        SA1     FM$GETNA
        SA0     X1      RESTORE (A0)
        EQ      FM$GETN RETURN
  
 FM$GETNA       BSS     1       SAVE CELL FOR (A0)
 FM$PUT SPACE   4,10
**      FM$PUT - PUT A RECORD FOR FM$RUN MAIN LOOP. 
* 
*       PROC FM$PUT;
*       FM$PUT(FDB,WSA,RL[,KEY,KP]);
* 
*       ENTRY   FDB = FIT ARRAY.
*               WSA = RECORD TO WRITE.
*               RL = RECORD LENGTH. 
*               KEY = OPTIONAL KEY FOR NON-SEQUENTIAL FILES.
*               KP = OPTIONAL KEY OFFSET (REQUIRES 'KEY').
* 
*       EXIT    RECORD HAS BEEN WRITTEN.
* 
*       CALLS   PUT$RM. 
  
  
        ENTRY   FM$PUT
  
 FM$PUT EQ      *+1S17  ENTRY/EXIT
        SX6     A0
        SA6     FM$PUTA SAVE (A0) 
        SA0     X1      (A0) = FIT ADDRESS
        SB1     1       (B1) := 1 
        SA1     A1+B1   (X1) = WSA ADDRESS
        SA3     A1+B1 
        SA2     X3      (X2) = RL 
        SA3     A3+B1   (X3) = KEY ADDRESS
        NZ      X3,FM$PUT1      IF A KEY GIVEN
        PUT     A0,X1,X2        WRITE SEQUENTIAL RECORD 
        EQ      FM$PUT3 
  
 FM$PUT1        SA4     A3+B1 
        NZ      X4,FM$PUT2      IF KP GIVEN 
        PUT     A0,X1,X2,,X3    WRITE RECORD/WORD ALIGNED KEY 
        EQ      FM$PUT3 
  
 FM$PUT2        SA4     X4      (X4) = KP 
        PUT     A0,X1,X2,,X3,X4 WRITE RECORD/NON-ALIGNED KEY
 FM$PUT3        SA1     FM$PUTA 
        SA0     X1      RESTORE (A0)
        EQ      FM$PUT  RETURN
  
 FM$PUTA        BSS     1       SAVE CELL FOR (A0)
  
 FM$MEMR  EJECT  LINKAGE, FIXED TABLE, AND CONSTANT AREA
**
*  VARIOUS EXTERNAL LINKAGES
* 
          ENTRY  FM$MEMR
 FM$MEMR  EQU    1           MEMORY BASE - MUST BE NON-ZERO FOR PASSLOC 
          SPACE  2
* 
          ENTRY  FM$FDB 
 FM$FDB   EQU    2           FDB POINTER ARRAY IN LOW CORE FOR DEBUG
          SPACE  2
* 
          ENTRY  FM$COMM
 FM$COMM  BSSZ   5           INTER-PROGRAM COMMUNICATION AREA 
          SPACE  2
* 
          ENTRY  FM$PKEY,FM$PKYA,FM$AKEY
 FM$PKEY  BSSZ   1           POINTER TO INPUT KEY 
 FM$PKYA  BSSZ   1           POINTER TO LAST ACTUAL OUTPUT KEY
 FM$AKEY  BSSZ   1           ACTUAL LAST ACTUAL KEY 
          SPACE  2
* 
          ENTRY  FM$IFDB,FM$LFDB
 FM$IFDB  BSSZ   46          INPUT FILE BLOCK 
 FM$LFDB  BSSZ   43          LISTING FILE BLOCK 
          CON    -1           BEGINNING SEQUENCE NUMBER (FLAG)
          BSSZ   2
          SPACE  4
          END 
