DEFINITION MODULE XINFLD;   (*$VER 0.1*)

(* ----------------------------------------------------------------------
               Copyright 1987 (c) by Telepath Systems, Inc.
                           All Rights Reserved


                       Module for Calling INFLD.SBR
  ---------------------------------------------------------------------- *)

PROCEDURE INFLD(row, col:     INTEGER;
               xmax, xmin:   INTEGER;
               VAR types:    ARRAY OF CHAR;
               VAR entry:    ARRAY OF CHAR;
               VAR inxctl:   INTEGER;
               deflt:        INTEGER;
               VAR exitcode: INTEGER;
               VAR timer:    INTEGER;
               cmdflg:       INTEGER;
               defpt, maxpt: INTEGER;
               funmap:       LONGCARD;
               VAR setdef:   ARRAY OF CHAR): BOOLEAN;

 (* Procedure for calling XINFLD.SBR from Micro Sabio. *)


END XINFLD.

================================= CUT HERE =================================

IMPLEMENTATION MODULE XINFLD;   (*$VER 1.0*)

(* ----------------------------------------------------------------------
               Copyright 1987 (c) by Telepath Systems, Inc.
                           All Rights Reserved


                       Module for Calling INFLD.SBR


  History: 1.0 100 10/14/87 MDT Original.
  ---------------------------------------------------------------------- *)

FROM SYSTEM IMPORT INLINE,SETREG,REG,ADDRESS,ADR,BYTE;


CONST
 D0 = 0; A0 = 8; A1 = 9; A2 = 10; A4 = 12; A5 = 13;

 SAVE     = 048E7H;  REST     = 04CDFH;
 saveA456 = 0000EH;  restA456 = 07000H;


TYPE
 ParRec = RECORD                       (* INFLD parameters record block  *)
   PROW:   INTEGER;                    (* screen row                     *)
   PCOL:   INTEGER;                    (* screen column                  *)
   PXMAX:  INTEGER;                    (* maximum field size             *)
   PXMIN:  INTEGER;                    (* minimum field size             *)
   PTYPAD: ADDRESS;                    (* address of type codes string   *)
   PENTAD: ADDRESS;                    (* address of entry input string  *)
   PENTSZ: INTEGER;                    (* size of entry input string     *)
   PINXAD: ADDRESS;                    (* address of INXCTL variable     *)
   PDEFLT: INTEGER;                    (* default mode specifier         *)
   PEXTAD: ADDRESS;                    (* address of EXITCODE variable   *)
   PTIMAD: ADDRESS;                    (* address of TIMER variable      *)
   PCMDFL: INTEGER;                    (* read from command file flag    *)
   PDEFPT: INTEGER;                    (* default decimal point position *)
   PMAXPT: INTEGER;                    (* limit digits to right of point *)
   PFUNMP: LONGCARD;                   (* function key translate bitmap  *)
   PSETAD: ADDRESS;                    (* address of SETDEF string       *)
   PSETSZ: INTEGER;                    (* size of SETDEF string          *)
 END;

VAR
 SBRPTR: ADDRESS;                      (* address of .SBR in memory      *)


(*** Internal Procedures ***)

PROCEDURE FetchSBR(name: ARRAY OF CHAR; VAR ptr: ADDRESS): BOOLEAN;
 (* Search for the .SBR in user memory, system memory, current account,
    project library account, and BAS:. Returns FALSE if not found. *)
VAR
 ddb: ARRAY [0..109] OF BYTE;
BEGIN
 SETREG(A2,ADR(name));
 SETREG(A0,ADR(ddb));
 INLINE(SAVE,saveA456);
 INLINE(07001H);                       (*         MOV     #1,D0          *)
 INLINE(03C3CH,07722H,04DD0H,0A068H);  (*         FSPEC   @A0,SBR        *)
 INLINE(04DD0H,07C01H,0A06CH,0224EH);  (*         FETCH   @A0,A1         *)
 INLINE(0672EH);                       (*         BEQ     past end       *)
 INLINE(0117CH,00000H,0000CH);         (*         MOVB    #0,0C(A0)      *)
 INLINE(04DD0H,07C01H,0A06CH,0224EH);  (*         FETCH   @A0,A1         *)
 INLINE(0671EH);                       (*         BEQ     past end       *)
 INLINE(0317CH,01C03H,00002H);         (*         MOVW    #01C03,2(A0)   *)
 INLINE(0317CH,00000H,00004H);         (*         MOVW    #0,4(A0)       *)
 INLINE(0317CH,00706H,0000CH);         (*         MOVW    #0706,0C(A0)   *)
 INLINE(04DD0H,07C01H,0A06CH,0224EH);  (*         FETCH   @A0,A1         *)
 INLINE(06702H);                       (*         BEQ     past end       *)
 INLINE(04280H);                       (*         CLR     D0             *)
 INLINE(REST,restA456);
 ptr := REG(A1);
 RETURN REG(D0) = 1D;
END FetchSBR;

PROCEDURE CallInfld(ptr: ADDRESS);
 (* calls INFLD's special assembly language interface *)
 (* Note that this is not the correct calling offset for most .SBR's *)
VAR
 WORK: ARRAY [0..399] OF BYTE;         (* work area for INFLD            *)
BEGIN
 INLINE(SAVE,saveA456);
 SETREG(A1,SBRPTR);
 SETREG(A5,ptr);
 SETREG(A4,ADR(WORK));
 INLINE(04EA9H,0000EH);                (*         CALL    0E(A1)         *)
 INLINE(REST,restA456);
END CallInfld;

PROCEDURE Len(VAR s: ARRAY OF CHAR): CARDINAL;
VAR
 h,i: CARDINAL;
BEGIN
 i := 0; h := HIGH(s);
 WHILE (i < h ) & (s[i] # 0C) DO
   INC(i);
 END;
 RETURN i;
END Len;


(*** Exported Procedures ***)

PROCEDURE INFLD(row, col:     INTEGER;
               xmax, xmin:   INTEGER;
               VAR types:    ARRAY OF CHAR;
               VAR entry:    ARRAY OF CHAR;
               VAR inxctl:   INTEGER;
               deflt:        INTEGER;
               VAR exitcode: INTEGER;
               VAR timer:    INTEGER;
               cmdflg:       INTEGER;
               defpt, maxpt: INTEGER;
               funmap:       LONGCARD;
               VAR setdef:   ARRAY OF CHAR): BOOLEAN;

VAR
 Params: ParRec;
BEGIN
 IF SBRPTR # NIL THEN
   WITH Params DO
     PROW    := row;
     PCOL    := col;
     PXMAX   := xmax;
     PXMIN   := xmin;
     PTYPAD  := ADR(types);
     PENTAD  := ADR(entry);
     PENTSZ  := HIGH(entry) + 1;
     PINXAD  := ADR(inxctl);
     PDEFLT  := deflt;
     PEXTAD  := ADR(exitcode);
     PTIMAD  := ADR(timer);
     PCMDFL  := cmdflg;
     PDEFPT  := defpt;
     PMAXPT  := maxpt;
     PFUNMP  := funmap;
     PSETAD  := ADR(setdef);
     PSETSZ  := Len(setdef);
   END;
   CallInfld(ADR(Params));
   RETURN TRUE;
 ELSE
   RETURN FALSE;
 END;
END INFLD;


BEGIN (*main*)

 IF NOT FetchSBR('INFLD.SBR', SBRPTR) THEN
   SBRPTR := NIL;
 END;

END XINFLD.

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.