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.