; ; .TITLE TRANS TRANSLATOR SUBROUTINE ; ; ; FAIRFIELD ENGINEERING COMPANY ; 324 BARNHART STREET ; MARION,OHIO 43302 1-614-387-3327 ; ; ABSTRACT: ; ; SUBROUTINE ACCEPTS AN INPUT LINE OF CHARACTERS, A VARIABLE TYPE, ; AND A VARIABLE SIZE. THE VARIABLE TYPE MAY BE I-INTEGER, ; L-LOGICAL,R-REAL,OR C-CHARACTER. A NUMBER OF BYTES EQUAL TO THE ; VARAIBLE SIZE IS MOVED FROM THE LINE OF CHARACTERS TO AN OUTPUT ; VARIABLE OF TYPE WHICH DEPENDS ON THE INPUT VARIABLE TYPE. THE ; POSSIBLITIES ARE INTEGER*4,LOGICAL*4,REAL*8 OR ; CHARACTER*(VARIABLE SIZE). ; ; ;AUTHOR: TOM TERRALL NOVEMBER 3,1978 ; ; ;FORTRAN CALL: CALL VARTRANS(LINE_CHAR,VAR_TYPE,VAR_SIZE,INT_VAR,LOG_VAR, ; REAL_VAR,CHAR_VAR,STATUS) ; ; ;PARAMETERS: ; ; VARIABLE MEANING FORTRAN POSITION ON ; VARBL TYPE ARGUMENT LIST ; -------- ------- ---------- ------------- ; ; LINE-CHAR INPUT LINE OF CHARS (VAR_SIZE)L*1 4 ; VAR_TYPE INPUT VARBLE TYPE C*1 8 (SEE NOTE) ; VAR_SIZE INPUT VARBLE SIZE L*1 12 ; INT_VAR OUTPUT INTGR VARBLE I*4 16 ; LOG_VAR OUTPUT LOGCL VARBLE L*4 20 ; REAL_VAR OUTPUT REAL VARBLE R*8 24 ; CHAR_VAR OUTPUT CHAR VARBLE C*(VAR_SIZE) 28 (SEE NOTE) ; STATUS TRANSLATION STATUS L*1 32 ; ; NOTE: ARGUMENT LIST CONTAINS FOR CHARACTER VARIABLES NOT THE ; ADDRESS OF VARIABLE BUT THE ADDRESS OF ITS DESCRIPTOR ; WHICH CONTAINS THE ADDRESS. ; ; ; STATUS CODES ; ------------ ; ; STATUS = 0 SUCCESSFULL TRANSLATION ; STATUS = -1 INPUT VARIABLE TYPE IS IMPROPER ; STATUS = -2 INPUT VARIABLE SIZE IS NON-POSITIVE ; STATUS = -3 INPUT VARIABLE SIZE DOES NOT MATCH INPUT VARIABLE TYPE ; ; ; ; ; .ENTRY VARTRANS ^M ; ; .ENABL DBG ; ; .LIST ; ; ; ;ADDRESS LOCATION OF PARAMETERS: ; VAR-TYPE <=> R8 ; LINE_CHAR <=> R9 ; VAR_SIZE <=> R7 ; INT_VAR <=> R11 ; LOG_VAR <=> R11 ; REAL_VAR <=> R11 ; CHAR_VAR <=> R11 ; ; ; TEST VARIABLE SIZE IS POSITIVE ; MOVAL @12(AP),R7 ;MOVE ADDRESS OF VAR_SIZE INTO R7 CMPB (R7),#0 ;TEST VAR_SIZE IS POSITVE BGTR 10$ ; MNEGB #2,@32(AP) ;LOAD STATUS WITH ERROR CODE FOR NON-POSITIVE ;VAR_SIZE BRW 98$ ; ; MOVE ADDRESSES OF PARAMENTERS INTO REGISTERS ; 10$: MOVAL @8(AP),R9 ;LOAD R9 WITH VAR_TYPE DESCRIPTOR ADDRESS MOVAL @4(R9),R8 ;LOAD R8 WITH ADDRESS OF VAR_TYPE MOVAL @4(AP),R9 ;MOVE ADDRESS OF LINE_CHAR INTO R9 ; ; IDENTIFY VAR_TYPE ; CMPB #^A/I/,(R8) ;VAR_TYPE INTEGER? BEQL 20$ ; ; CMPB #^A/L/,(R8) ;VAR_TYPE LOGICAL? BEQL 30$ ; ; CMPB #^A/R/,(R8) ;VAR_TYPE REAL? BEQL 40$ ; ; CMPB #^A/C/,(R8) ;VAR_TYPE CHARACTER? BEQL 50$ ; ; MNEGB #1,@32(AP) ;LOAD ERROR CODE FOR IMPROPER VARIABLE TYPE BRW 98$ ; ; INTEGER VARIABLE TYPE ; 20$: CMPB #2,(R7) ;VAR_SIZE =2? BNEQ 22$ ; ; CVTWL (R9),@16(AP) ;CONVERT WORD FROM LINE_CHAR INTO LONG WORD IN ; INT_VAR BRW 95$ ; ; 22$: CMPB #4,(R7) ;VAR_SIZE=4? BNEQ 90$ ;BRANCH TO ERROR MESSAGE MOVL #16,R11 ;LOAD DISPLACEMENT OF INT_VAR ON ARGUMENT LIST INTO R11 BRW 80$ ;BRANCH TO MOVE 4 WORDS ; ; LOGICAL VARIABLE TYPE ; 30$: CMPB #1,(R7) ;VAR_SIZE=1? BNEQ 32$ ; CVTBL (R9),@20(AP) ;COVERT BYTE IN LINE_CHAR TO LONG WORD IN LOG_VAR BRW 95$ ; ; 32$: CMPB #2,(R7) ;VAR_SIZE=2? BNEQ 34$ ; CVTWL (R9),@20(AP) ;COVERT WORD OF LINE_CHAR TO LONG WORD IN LOG_VAR BRW 95$ ; ; 34$: CMPB #4,(R7) ;VAR_SIZE=4? BNEQ 90$ ;BRANCH TO SET ERROR CODE MOVL #20,R11 ;LOAD DISPLACEMENT OF LOG_VAR ON ARGUMENT LIST INTO R11 BRW 80$ ; ; ; REAL VARIABLE TYPE ; 40$: CMPB #4,(R7) ;VAR_SIZE=4? BNEQ 44$ CVTFD (R9),@24(AP) ;CONVERT 4BYTES IN LINE_CHAR TO 8 BYTES IN REAL_VAR BRW 95$ ; ; 44$: CMPB #8,(R7) ;VAR_SIZE=8? BNEQ 90$ ;BRANCH TO LOAD ERROR CODE MOVL #24,R11 ;LOAD DISPLACEMENT OF REAL_VAR ON ARGUMENT LIST INTO R11 BRW 80$ ; ; ; CHARACTER VARIABLE TYPE ; 50$: ADDL3 AP,#28,R10 ;LOAD R10 WITH ADDRESS ON ARGUMENT LIST OF ADDRESS ; OF CHAR_VAR DESCRIPTOR ADDL3 (R10),#4,R11 ;LOAD R11 WITH ADDRESS IN CHAR_VAR DESCRIPTOR ;OF CHAR_VAR VARIABLE ADDRESS ;DESCRIPTOR BRW 82$ ; ; ; ; MOVE DATA (CHAR,I*4,L*4,R*8) ; 80$: ADDL2 AP,R11 82$: MOVC5 (R7),(R9),#^A/ /,(R7),@(R11) ;MOVE VAR_SIZE BYTES FROM ;LINE_CHAR TO ;OUTPUT VARIABLE ; ; END SUBROUTINE ; 95$: MOVB #0,@32(AP) ;LOAD SUCCESS CODE INTO STATUS BRW 98$ ; ; LOAD ERROR CODE FOR IMPROPER VAR_SIZE FOR VAR_TYPE INTO STATUS 90$: MNEGB #3,@32(AP) ; ; 98$: RET ;RETURN TO CALLING PROGRAM ; .END