.ENABL LC .TITLE IDSPTC ; IDSPTC provides a link between a subroutine identified ; by a number in FORTRAN program TXTWRT and a required call to ; execute that subroutine. ; ; Called from FORTRAN by: ; I = IDSPTC(NCMD,NARGS,IARGS) ; where: ; NCMD - Number (1-79) of subroutine to be called ; NARGS - Number (0-20) of arguments to be passed ; IARGS - Vector containing the arguments ; I - Returned function value ; = -2 - Too many arguments for this subroutine ; = -1 - Subroutine number code out of range ; = 0 - Success ; ;Symbol Definitions TBLSZE = 79. ;Number of entries in dispatch table MAXARG = 20. ;Maximum number of arguments supported .GLOBL IDSPTC ;Entry point .GLOBL ALIGND ANSI BIGBOT BIGTOP CLRALL .GLOBL CLRBEG CLRBOT CLREND CLRLIN CLRTOP CRLF CUB .GLOBL CUD CUF CUP CUU DCSDIF DCS105 DCS125 .GLOBL DWL GIMOAP GIMOHC GPOFF GPON HPA HPR .GLOBL HRDCPY HTBCLA HTBCLC HTBSTC HTBSTS IND KPAM .GLOBL KPNM LLEDS LNEFDM MDCPY NEL NWLNEM PLD .GLOBL PLU RESCUR RGSTRM RI RIS RM RPTCP .GLOBL RPTDS RPTID SAVCUR SCSAL1 SCSAL2 SCSFIN SCSFRA .GLOBL SCSGER SCSGRF SCSNOR SCSQUE SCSSWE SCSUK SCSUSA .GLOBL SCS0 SCS1 SETLPP SETLRM SETTBM SGR SHPTCH .GLOBL SM SS2 SS3 SVPTCH SWL VPA VPR .GLOBL VTBCLA VTBCLC VTBSTC VTBSTS .PAGE .PSECT USER$I,RW,I,LCL,REL,CON IDSPTC: MOV #-1,R0 ;Assume error condition exists CMP #3,(R5)+ ;Check argument count BNE 1$ ;Error exit if wrong MOV @(R5)+,R4 ;Get NCMD value BLE 1$ ;Must be greater than zero CMP #TBLSZE,R4 ;Compare against the #routines defined BLT 1$ ;Error exit if not within range MOV @(R5)+,R3 ;Get NARGS - #arguments to pass BLT 1$ ;Must be positive (or zero) CMPB ARGCNT-1(R4),R3 ;But less or equal to defined limit BGE 2$ ;Jump if OK DEC R0 ;Define argument count error 1$: RETURN ;Error return 2$: MOV #IARGS,R0 ;Point to argument vector MOV R3,(R0)+ ;Load user's argument count MOV (R5)+,R1 ;Point to first user argument 3$: DEC R3 ;Count down #addresses to transfer BMI 4$ ;Done when negative MOV R1,(R0)+ ;Load in the address of next arg. TST (R1)+ ;Update pointer thru arg. list BR 3$ ;Go load next one 4$: MOV #IARGS,R5 ;Build FORTRAN linkage ASL R4 ;Convert NCMD to word pointer CALL @SUBNME-2(R4) ;Call selected subroutine CLR R0 ;Report success RETURN ; to caller .PAGE .PSECT USER$D,RW,D,LCL,REL,CON .NLIST BEX SUBNME: .WORD ALIGND, ANSI, BIGBOT, BIGTOP, CLRALL .WORD CLRBEG, CLRBOT, CLREND, CLRLIN, CLRTOP, CRLF, CUB .WORD CUD, CUF, CUP, CUU, DCSDIF, DCS105, DCS125 .WORD DWL, GIMOAP, GIMOHC, GPOFF, GPON, HPA, HPR .WORD HRDCPY, HTBCLA, HTBCLC, HTBSTC, HTBSTS, IND, KPAM .WORD KPNM, LLEDS, LNEFDM, MDCPY, NEL, NWLNEM, PLD .WORD PLU, RESCUR, RGSTRM, RI, RIS, RM, RPTCP .WORD RPTDS, RPTID, SAVCUR, SCSAL1, SCSAL2, SCSFIN, SCSFRA .WORD SCSGER, SCSGRF, SCSNOR, SCSQUE, SCSSWE, SCSUK, SCSUSA .WORD SCS0, SCS1, SETLPP, SETLRM, SETTBM, SGR, SHPTCH .WORD SM, SS2, SS3, SVPTCH, SWL, VPA, VPR .WORD VTBCLA, VTBCLC, VTBSTC, VTBSTS ARGCNT: .BYTE 0, 0, 0, 0, 0 .BYTE 0, 0, 0, 0, 0, 0, 1 .BYTE 1, 1, 2, 1, 0, 0, 0 .BYTE 0, 0, 0, 0, 0, 1, 1 .BYTE 0, 0, 0, 0, 20., 0, 0 .BYTE 0, 4, 0, 1, 0, 0, 0 .BYTE 0, 0, 0, 0, 0, 1, 0 .BYTE 0, 0, 0, 1, 1, 1, 1 .BYTE 1, 1, 1, 1, 1, 1, 1 .BYTE 0, 0, 1, 2, 2, 4, 1 .BYTE 1, 0, 0, 1, 0, 1, 1 .BYTE 0, 0, 0, 20. .EVEN IARGS: .BLKW MAXARG+1 ;Allocate space for arg. addresses .END