{******************************************************************************}
{*                                                                            *}
{*                         IMP PROLOG                                         *}
{*                         ==========                                         *}
{*                                                                            *}
{******************************************************************************}

{Comment flags:   VAX APM EMAS I77}

{All systems but EMAS require I77}

{Original EMAS version in Imp9 by Luis Damas of EUCSD}
{     Then Lawrence Byrd et al of EDAI}

{Portable version built by Richard M. Marshall}

{Moved To VAX/VMS in Imp77 in Early 1984}
{Moved back to EMAS in Imp80 form in Early 1984}
{Moved to EUCSD APM 25th April 1984}

!VAX! %include "Prolog_Interpreter:GDec.Inc"
!EMAS!%include "ECSC56.GDec#Inc"
{APM} %include "IPlog:GDec.Inc"

{stack bases}

%EXTERNAL %INTEGER ATOM0, 
                   AUXSTK0,
                   TRBASE, 
                   SKEL0, 
                   GLB0, 
                   LCL0

{stack limits}

%external %integer Atom Limit,
                   Aux Limit,
                   Trail Limit,
                   Skel Limit,
                   Global Limit,
                   Local Limit

%constant %integer N Stacks = 6
%external %integer %array %spec STK LEN(1:NSTACKS)
!EMAS!%external %string(7) %array %spec STKNAME(1:NSTACKS)

%external %integer %spec Options

! system routines specifications

{APM} %dynamic %string (63) %fn %spec EDWIN ERROR %alias "EDWIN_ERROR" (%integer X)
{APM} %include "Inc:Util.Imp"
{APM} %dynamic %integer %function %spec Edit -
{APM}                                   %alias "NEWS_EDIT" -
{APM}                                   (%string (255) In, Sec, Out,
{APM}                                    %integer X, Y)
{APM} %include "IE:Terminal.Inc"

{APM} @16_372C %byte Control Y Trap

!VAX! %external %predicate %spec Exists (%string (127) F)
!VAX! %external %integer %function %spec Get VM %alias "LIB$GET_VM" %c
!VAX!                                    (%integer %name Size, Addr)

!VAX! %external %routine %spec Set Default (%string (127) F)
!VAX! %external %string (127) %function %spec Current Default


!VAX! %external %string (127) %function %spec translate (%string (127) name)
!VAX! %include "IE_Release:IE.Inc"
!VAX! %include "Edwin_Dir:Specs.Inc"

!EMAS!%external %routine %spec P Hex (%integer A)
!EMAS!%external %routine %spec Prompt (%string (31) P)
!EMAS!%external %routine %spec Destroy (%string(255) What)
!EMAS!%external %integer %function %spec Exist (%string (255) File)
!EMAS!%external %routine %spec Rename (%string (255) Files)
!EMAS!%external %routine %spec Call (%string (255) Command, Parameter)
!EMAS!%EXTERNALROUTINE %SPEC DEFINE(%STRING(63) S)
!EMAS!%EXTERNALROUTINE %SPEC NEWSMFILE(%STRING(63) S)
!EMAS!%EXTERNALROUTINE %SPEC CLEAR(%STRING(255) S)
!EMAS!%EXTERNALROUTINE %SPEC DISCONNECT(%STRING(63) S)
!EMAS!%external %routine %spec SSFOFF
!EMAS!%EXTERNALINTEGER %function %SPEC RETURN CODE
!EMAS!%EXTERNALSTRING(255)%function %SPEC SSFMESSAGE
!EMAS!%EXTERNALINTEGER %function %SPEC SMADDR(%INTEGER CHAN,%INTEGERNAME LEN)
!EMAS!%EXTERNALROUTINE %SPEC CLOSESM(%INTEGER CHAN)

! miscellaneous utilities

!EMAS!%external %string (63) %function %spec I To S (%integer I, F)

! prolog external routines specifications

%EXTERNALINTEGER %function %SPEC GUNIFY(%INTEGER T1,G1,T2,G2)
%EXTERNALINTEGER %function %SPEC OP(%INTEGER P,T,O)
%EXTERNALINTEGER %function %SPEC RECORD(%INTEGER KEY, T, RK, AORZ)
%EXTERNALINTEGER %function %SPEC ERASE(%INTEGER R)
%EXTERNALINTEGER %function %SPEC LOOKUP(%string (*) %name S)
%EXTERNALINTEGER %function %SPEC READ Term
%EXTERNALROUTINE %SPEC P WRITE(%INTEGER T,G,P)
%external %routine %spec B Write (%integer I, J)
%EXTERNALINTEGER %function %SPEC INTVAL(%INTEGER T)
%EXTERNALINTEGER %function %SPEC APPLY(%INTEGER ATOM, ARITE, ARGS)
%EXTERNALINTEGER %function %SPEC FENTRY(%INTEGER AT,N)
%EXTERNALINTEGER %function %SPEC MAKELIST(%INTEGER N,ELS)
%EXTERNALROUTINE %SPEC RELEASEC(%INTEGER C)
%EXTERNALROUTINE %SPEC RELEASEP(%INTEGER P, L)
%EXTERNALINTEGER %function %SPEC GETSP(%INTEGER L)
%EXTERNALINTEGER %function %SPEC ARG(%INTEGER P, F)
%EXTERNALINTEGER %function %SPEC ARGV(%INTEGER P,F,%INTEGERNAME AF)
%EXTERNALINTEGER %function %SPEC DEREF(%INTEGER VP)
%EXTERNALINTEGER %function %SPEC VVALUE(%INTEGER VP,%INTEGERNAME TF)
%external %routine %spec No Space (%string (31) In)
%dynamic %integer %function %spec Call Edwin
%external %integer %function %spec Take Interrupt Action

! Lawrences additional routines

%EXTERNALROUTINE %SPEC  SIGNAL PROLOG EVENT(%INTEGER E)
%EXTERNALROUTINE %SPEC  GETC(%%byteNAME CH)

!VAX! %external %integer Control C Trapped = 0
!VAX! %external %routine %spec Can Ctrl C
!VAX! %external %routine %spec On Ctrl C (%routine R)
!VAX! %own %integer Not Just Hamish Either
!VAX! 
!VAX! %external %routine %spec Trap Control C

{-CREATE STACKS-}

%routine Create Stacks

!EMAS!   %INTEGER I, LA, SA, FA, FL, Limit
!EMAS!
!EMAS!   %for I=1,1,NSTACKS %cycle
!EMAS!      %IF Exist(STKNAME(I))#0 %THEN Destroy(STKNAME(I))
!EMAS!   %REPEAT
!EMAS!   LA = 0
!EMAS!   SA = ADDR (ATOM0)
!EMAS!   Limit = Addr (Atom Limit)
!EMAS!   %for I=1,1,NSTACKS %cycle
!EMAS!      NEW SM FILE (STK NAME (I). "," . %c
!EMAS!                   I To S (STK LEN (I)<<10 - 40, 0))
!EMAS!      DEFINE("7".TOSTRING('0'+I).",".STKNAME(I))
!EMAS!      FA=SMADDR(70+I,FL)
!EMAS!      %IF RETURN CODE #0 %START
!EMAS!         PRINTSTRING(SSFMESSAGE)
!EMAS!         %STOP
!EMAS!      %FINISH
!EMAS!      %IF FA<LA %START
!EMAS!         PRINTSTRING("** Unable to connect stacks in proper order")
!EMAS!         New Line
!EMAS!         %STOP
!EMAS!      %FINISH
!EMAS!      INTEGER (SA) = FA - 32
!EMAS!      Integer (Limit) = FA - 32 + STK Len (I)<<10
!EMAS!      LA = FA
!EMAS!      SA = SA + 4
!EMAS!      Limit = Limit + 4
!EMAS!   %REPEAT

!VAX!  %integer A, VMA, LA, I, Status, Length, Limit

!VAX!    A = Addr (Atom0)
!VAX!    Limit = Addr (Atom Limit)
!VAX!    LA = 0
!VAX!    %for I = 1, 1, N Stacks %cycle
!VAX!       Length = Stk Len (I)<<10            {in bytes}
!VAX!       Status = Get VM (Length, VMA)
!VAX!       %if Status&1 = 0 %start
!VAX!          Print String ("** Failed to create work space")
!VAX!          New Line
!VAX!          %stop
!VAX!       %finish
!VAX!       %if VMA < LA %start
!VAX!          Print String ("** Stacks not in correct order")
!VAX!          New Line
!VAX!          %stop
!VAX!       %finish
!VAX!       Integer (A) = VMA
!VAX!       Integer (Limit) = VMA + Length
!VAX!       LA = VMA
!VAX!       A = A + 4
!VAX!       Limit = Limit + 4
!VAX!    %repeat

{APM}  %on 2 %start
{APM}     Print String ("** Failed to create work space (Try FORGET *)")
{APM}     New Line
{APM}     %stop
{APM}  %finish

{APM}  %integer A, Store Address, LA, I, Length, Limit

{APM}    A = Addr (Atom0)
{APM}    Limit = Addr (Atom Limit)
{APM}    LA = 0
{APM}    %for I = 1, 1, N Stacks %cycle
{APM}       Length = Stk Len (I)<<10            {in bytes}
{APM}       Store Address = Heap Get (Length) 
{APM}       Integer (A) = Store Address
{APM}       Integer (Limit) = Store Address + Length
{APM}       LA = Store Address
{APM}       A = A + 4
{APM}       Limit = Limit + 4
{APM}    %repeat

%END {Create Stacks}

!EMAS!{-RELEASE STACKS-}

!EMAS!%routine Release Stacks
!EMAS!   %INTEGER I
!EMAS!
!EMAS!   CLEAR("")
!EMAS!   %for I=1,1,NSTACKS %cycle
!EMAS!      Destroy(STKNAME(I))
!EMAS!   %REPEAT
!EMAS!%END {Release Stacks}

{several atoms required by system}

%constant %integer Rqrd Atoms = 8
%EXTERNAL %INTEGER ATOMNIL,               {[]}
                   COMMAFUNC,             {,}
                   ASSERTATOM,            {}
                   ENDOFFILE,             {end_of_file}
                   ATOMTRUE,              {true}
                   USER,                  {user}
                   LIVE,                  {$live}
                   BREAK                  {$break}

{functors required explicitly by system}
%constant %integer Rqrd Funcs = 6

%EXTERNAL %INTEGER CALLTAG,            {call(_)}
                   COMMATAG,           {','(_,_)}
                   ASSERTFUNC,         {}{(_)}
                   LISTFUNC,           {'.'(_,_)}
                   ARROWTAG,           {':-'(_,_)}
                   PROVEFUNC           {':-'(_)}

%EXTERNALINTEGER LIST10

! variables for comunication with PLIO

%EXTERNAL %INTEGER HASHA, 
                   LC, 
                   VARCHAIN, 
                   NVARS, 
                   VARFP, 
                   LSP, 
                   LSZ,
                   QUOTEIA, 
                   ATOMFP
!EMAS! %EXTERNALSTRING(31) PLPROMPT
!EMAS! %constant %integer PL Prompt Length = 31

!VAX!  %external %string (127) PL Prompt
!VAX!  %constant %integer PL Prompt Length = 127

{APM}  %external %string (255) PL Prompt
{APM}  %constant %integer PL Prompt Length = 255

%external %integer AT Prompt

%EXTERNAL %INTEGER PROLOG EVENT = 0

! critical execution and start up flags

%EXTERNAL %INTEGER  CRIT = 0, 
                    RUNNING = 0

! variables for communication with DBASE

%EXTERNAL %INTEGER VRA, 
                   VRZ      

! General error message passing string

%EXTERNALSTRING(255) ERROR MES

! heap management variables

%EXTERNAL %INTEGER FHPP, 
                   HEAP FREE, 
                   HEAP FREE 2, 
                   HEAP USED

! main loop global variables

{comments taken from C version}

%EXTERNAL %INTEGER X,          {local \ pointer for parent goal}
                   X1,         {global/                        }
                   V,          {local pointer for current goal}
                   V1,         {top of global stack}
                   VV,         {local \ pointer for last choice point}
                   VV1,        {global/                              }
                   V1F,        {global pointer for current goal}
                   TR,         {top of trail}
                   TR0         {backtrack point}

! main loop local variables

%EXTERNAL %INTEGER DEBUG, 
                   EXECSYS, 
                   PG, 
                   G, 
                   INFO, 
                   LEV, 
                   C, 
                   INVOKNO, 
                   FL

%own %integer Size

!  miscellaneous

%external %INTEGER %spec Version
%external %INTEGER %spec Save Version
%external %STRING(127) %spec Boot File
%external %STRING(127) %spec Standard Startup

!  Basic debugging package variables and constants

%EXTERNAL %INTEGER SPY, 
                   SKLEV, 
                   PORT, 
                   GF, 
                   LEASH
%constant %INTEGER CALL PORT = 1, 
                   EXIT PORT = 2, 
                   BACK TO PORT = 3
%constant %string (10) %array Port Name (1:3) = %C
     "Call: ", "Exit: ", "Back to: "

{-CHECK V1-}

%external %routine Check V1 (%integer P)
   No Space ("GLOBAL") %if V1 + P > Global Limit
%end {Check V1}

{UNIFY ARG}

%external %integer %function Unify Arg (%INTEGER A,T,TF)
   A = INTEGER (A) %WHILE INTEGER (A) >= GLB0
   %IF INTEGER (A) = 0 %START
      %IF GLB0 > T >= SKEL0 %START
         Check V1 (8)
         INTEGER(V1)=T
         INTEGER(V1+4)=TF
         INTEGER(A)=V1
         V1 = V1 + 8
         -> TRAIL A
      %FINISH
      %IF T >= GLB0 %AND %C
          INTEGER (T) = 0 %AND %C
          T >= A %START
         %RESULT = 1 %IF T = A
         INTEGER (T) = A
         -> TRAIL T
      %FINISH
      INTEGER (A) = T
   TRAIL A: 
      INTEGER (TR) = A %AND TR = TR + 4 %IF A < VV1 %OR %c
                                            LCL0 <= A < VV
      %RESULT = 1
   %FINISH
   %IF T >= GLB0 %AND %c
       INTEGER (T) = 0 %START
      INTEGER (T) = INTEGER (A)
      -> TRAIL T
   %FINISH
   %RESULT = 1 %IF T = INTEGER (A) %AND %c
                   T < SKEL0
   %RESULT = 0 %IF T < SKEL0 %OR %c
                   A < GLB0
                    
   %RESULT = GUNIFY (INTEGER (A), INTEGER (A + 4), T, TF)

TRAIL T: 
   INTEGER (TR) = T %AND TR = TR + 4 %IF T < VV1 %OR %c
                                         LCL0 <= T < VV
   %RESULT = 1
%end {Unify Arg}

%external %INTEGER INPUT, OUTPUT       {currently selected prolog streams}


{-------------------------------PROLOG INTERPRETER-----------------------------}

%external %routine Prolog Interpreter (%string (127) PL File)

%INTEGER BRKLEV
%own %INTEGER F,
              D,
              B,
              K,
              K1,
              N,
              Y,
              P,
              L,
              ARG1
%byte CH,CH2
%byte %name BN

{APM} {Stuff for IE}
{APM} %integer Junk, Set Up = 0

! constants related to debugging

%constant %integer SYS FLGS     = 128 + 64, 
                   SYS FLGT     = 64, 
                   SYS FLGP     = 128,
                   TRACE FLAG   = 32,
                   SPY FLAG     = 16,
                   EXEC SYS FLG = 16_40000000,
                   LEV W        = 12, 
                   MASK INVK    = 16_3FFFF, 
                   MASK LEV     = 16_FFF                

%SWITCH ACTION   (1:4), 
        STD PRED (0:127)


!-----------------------------------------------------------------------

!         file handling routines

%integer FILE ERRORS, READING, TO SEE, To Close

!VAX!  %constant %integer Max Stream = 15
!EMAS! %constant %integer Max Stream = 9
{APM}  %constant %integer Max Stream = 3

%integer %array File Name (0:Max Stream)
%byte %array File State   (0:Max Stream)

{I77} %byte %array File Direction (0:Max Stream)
{I77} %constant %integer Being Seen = 0,
{I77}                    Being Told = 1

{I77} {-CLOSE STREAM-}

{I77} %routine Close Stream (%integer Stream)
{I77}    %integer Save

{I77}    %on 9 %start
{I77}       Error Mes = Event_Message
{I77}       Signal Prolog Event (2)
{I77}    %finish

{I77}    %return %if Stream = 0
{I77}    %if File Direction (Stream) = Being Seen %start
{I77}       Save = In Stream
{I77}       Select Input (Stream)
{I77}       Close Input
{I77}       Select Input (Save)
{I77}    %else
{I77}       Save = Out Stream
{I77}       Select Output (Stream)
{I77}       Close Output
{I77}       Select Output (Save)
{I77}    %finish
{I77} %end {Close Stream}

%STRING(255) File String

{-TO UPPER-}

%string (255) %function To Upper (%string (255) S)
   %integer N
   %byte %name Ch
   %constant %integer Shift = 32

   %if Length (S) > 0 %start
      %for N = 1, 1, Length (S) %cycle
         Ch == Char No (S, N)
         Ch = Ch - Shift %if 'a' <= Ch <= 'z'
      %repeat
   %finish
   %result = S
%end {To Upper}

{-ATOM TO FILE-}

%ROUTINE ATOM TO FILE(%INTEGER A)
   ! if a is an atom it's representation is 
   ! stored in File String otherwise a 'files fail' is caused
   %IF A < ATOM0 %OR A >= SKEL0 %START
     ERROR MES="! Invalid file specification"
     SIGNAL PROLOG EVENT(2)
   %FINISH
   File String = To Upper (STRING (A + ST OF AE))
%END

{-LOOK FILE-}

{Returns a stream number for the file name given as I/O predicate}

%integer %function Look File
   %INTEGER I, N, R, K

{I77} %on 3, 9 %start
{I77}    Error Mes = Event_Message
{I77}    Signal Prolog Event (2)
{I77} %finish

   K = INTEGER (X + V1 OF CF)
   R = -1
   N = -1
   %for I = 0, 1, Max Stream %cycle
{I77} %continue %if I = 3                                {IE uses stream 3}

!EMAS!%IF FILENAME (I) = K %start      {See if already open}

{I77} %if File Name (I) = K %and %c
{I77}     File State (I) # 0 %start

         N = I 
         %EXIT
      %finish
      R = I %IF FILE STATE (I) = 0
   %REPEAT

   %RESULT = N %IF N >= 0
   %result = -1 %if To Close # 0

   %IF R < 0 %START
      ERROR MES="! attempt to open more than " . I To S (Max Stream, 0) . " files"
      SIGNAL PROLOG EVENT(2)
   %FINISH

   ATOM TO FILE(K)

!EMAS!  DEFINE(TO STRING('0'+R).",".File String)
!EMAS!  %IF RETURN CODE#0 %START
!EMAS!    ERROR MES=SSFMESSAGE
!EMAS!    SIGNAL PROLOG EVENT(2)
!EMAS!  %FINISH
!EMAS!  %IF TO SEE=1 %AND Exist(File String) = 0 %START
!EMAS!     ERROR MES="! file ".File String." does not exist"
!EMAS!     SIGNAL PROLOG EVENT(2)
!EMAS!  %FINISH

{I77}   %if To See = 1 %start
{I77}      Open Input (R, File String)
{I77}      File Direction (R) = Being Seen
{I77}   %else
{I77}      Open Output (R, File String)
{I77}      File Direction (R) = Being Told
{I77}   %finish

   FILENAME (R) = K
   %RESULT = R
%END {Look File}

{INIT IO}

%ROUTINE Init IO
   %INTEGER I

   %for I = 1, 1, Max Stream %cycle
      FILE NAME (I) = 0
      FILE STATE (I) = 0
   %REPEAT
   FILE NAME (0) = USER
   FILE STATE (0) = 4
   INPUT = 0
   OUTPUT = 0
   To See = 0
   To Close = 0
!VAX! Set Default (".PRO")
%END {Init IO}

{CLOSE FILES}

%ROUTINE Close Files
   %INTEGER I

   SELECT INPUT (0) %AND INPUT = 0 %IF INPUT # 0
   SELECT OUTPUT (0) %AND OUTPUT = 0 %IF OUTPUT # 0
   %for I = 1, 1, Max Stream %cycle
      Close Stream (I) %IF FILE STATE (I) # 0
   %REPEAT
%END {Close Files}

{-SET PL PROMPT-}

%ROUTINE SET PLPROMPT(%STRING(255) S)
   %if Length (S) > PL Prompt Length %start
      PL Prompt = Sub String(S, 1, PL Prompt Length)
   %else
      PLPROMPT = S
   %finish
   PROMPT (PLPROMPT)
%END {Set PL Prompt}

%SWITCH RTN AFT BREAK(1:3)
%own %INTEGER BRTN,
              BRKP,
              VCHAIN,
              RECONS,
              PVRZ 

%integer BG,
         SAVEAD

{-SAVE V-}

%ROUTINE SAVEV (%INTEGER %NAME V, %INTEGER N)
   ! saves n vars starting with V
   %INTEGER P
   P = ADDR(V)
   %WHILE N > 0 %CYCLE
      INTEGER (SAVE AD) = INTEGER (P)
      SAVE AD = SAVEAD + 4
      P = P + 4
      N = N - 1
   %REPEAT
%END

{RSTRV}

%routine RSTRV (%INTEGER %NAME V, %INTEGER N)
   ! restores n vars starting with V
   %INTEGER P

   P = ADDR(V)
   %WHILE N > 0 %CYCLE
      INTEGER (P) = INTEGER (SAVE AD)
      P = P + 4
      SAVEAD = SAVEAD + 4
      N = N - 1
   %REPEAT
%END

{SAVE VARS}

%ROUTINE SAVE VARS
   ! to enter a break
   %INTEGER NBRKP

   NBRKP = V + 200
   SAVE AD = NBRKP
   Save V (BRTN, 5)
   Save V (VRA, 2)
   Save V (X, 9) 
   Save V (DEBUG, 9)
   Save V (LC, 1)
   Save V (F, 9)
   Save V (SPY, 5)
   VRA = VRZ
   V = SAVEAD
   BRKP = NBRKP
%END {Save Vars}

{RESTORE VARS}

%ROUTINE RESTORE VARS
   ! to continue from a break
   SAVEAD=BRKP
   RSTRV (BRTN,5)
   RSTRV (VRA,2)
   RSTRV (X,9) 
   RSTRV (DEBUG,9)
   RSTRV (LC,1)
   RSTRV (F,9)
   RSTRV (SPY,5)
%END {Restore Vars}

!VAX! {-TEMPORARY VERSION OF IMP LIBRARY ROUTINES-}
!VAX! 
!VAX! %routine Open Binary Input (%integer Stream, %string (127) File)
!VAX!    Open Input (Stream, File . "-B")
!VAX! %end 
!VAX! 
!VAX! %routine Open Binary Output (%integer Stream, %string (127) File)
!VAX!    Open Output (Stream, File . "-B")
!VAX! %end

!VAX! {-READ MEMORY-}
!VAX! 
!VAX! %routine Read Memory (%integer Address,
!VAX!                                Length)
!VAX!    %integer I
!VAX! 
!VAX!    %for I = 1, 1, Length %cycle
!VAX!       Read Symbol (Byte Integer (Address))
!VAX!       Address = Address + 1
!VAX!    %repeat
!VAX! %end {Read Memory}
!VAX! 
!VAX! {-WRITE MEMORY-}
!VAX! 
!VAX! %routine Write Memory (%integer Address,
!VAX!                                 Length)
!VAX!    %integer I
!VAX! 
!VAX!    %for I = 1, 1, Length %cycle
!VAX!       Print Symbol (Byte Integer (Address))
!VAX!       Address = Address + 1
!VAX!    %repeat
!VAX! %end {Write Memory}
   
{APM} {-READ MEMORY-}
{APM} 
{APM} %routine Read Memory (%integer Address,
{APM}                                Length)
{APM}    %integer I
{APM} 
{APM}    %for I = 1, 1, Length %cycle
{APM}       Read Symbol (Byte Integer (Address))
{APM}       Address = Address + 1
{APM}    %repeat
{APM} %end {Read Memory}
{APM} 
{APM} {-WRITE MEMORY-}
{APM} 
{APM} %routine Write Memory (%integer Address,
{APM}                                 Length)
{APM}    %integer I
{APM} 
{APM}    %for I = 1, 1, Length %cycle
{APM}       Print Symbol (Byte Integer (Address))
{APM}       Address = Address + 1
{APM}    %repeat
{APM} %end {Write Memory}

{-SAVE-}

{Saves current prolog state in file name given as atom parameter}

%integer %function Save
   %constant %integer Round= \7
   {Length and Relative offset pairs for all the stacks}
   %own %integer LAT,   RAT,        {Atom}
                 LAUX,  RAUX,       {Aux}
                 LTR,   RTR,        {Trace}
                 LSKEL, RSKEL,      {Heap}
                 LGLB,  RGLB,       {Global}
                 LLCL,  RLCL,       {Local}
                 SAVEP

   %integer FLENG,
            FA,
            I,
            J,
            K,
            L,
            R,
            S

{I77} %integer Saved Stream,
{I77}          Vars Saved = 0
!VAX! %string (127) Saved Default

{I77} %byte %array Block (0 : 255)

   {TRAP ERRORS}

{I77}   %on 9 %start
!VAX!      Set Default (Saved Default)
{I77}      Select Output (Saved Stream)
{I77}      Restore Vars %if Vars Saved = 1
{I77}      %result = 0
{I77}   %finish

   {Get File Name for saving to}
   Atom To File (Integer (X + V1OFCF))

   {Delete any version already there}
!EMAS!Destroy (File String) %IF Exist(File String)#0

   ! save state into temporary storage in LCL

   SAVE VARS
{I77} Vars Saved = 1
   SAVEP = SAVE AD - LCL0
   SAVEV (ATOM NIL, RQRD ATOMS)        {Save other variables at known locations}
   SAVEV (CALL TAG, RQRD FUNCS)
   SAVEV (AT PROMPT, 1)
   SAVEV (BRK LEV, 1)
   SAVEV (ATOM FP, 1)

   {compute length and offsets of different stacks}
   RAT   = 200                            {Leave room for variables}
   LAT   = (ATOM FP - ATOM0 + 7)&ROUND
   RAUX  = RAT + LAT
   LAUX  = (VRZ - AUXSTK0 + 7)&ROUND
   RTR   = RAUX + LAUX
   LTR   = (TR - TRBASE + 7)&ROUND
   RSKEL = RTR + LTR
   LSKEL = (FHPP - SKEL0 + 7)&ROUND
   RGLB  = RSKEL + LSKEL
   LGLB  = (V1 - GLB0 + 7)&ROUND
   RLCL  = RGLB + LGLB
   LLCL  = (SAVEAD - LCL0 + 15)&ROUND
   FLENG = RLCL + LLCL

   {allocate file and connect it}
!EMAS!   NEWSMFILE(File String.",".I To S(FLENG, 0))
!EMAS!
!EMAS!   DEFINE("11,".File String)
!EMAS!   FA=SMADDR(11,FLENG)

{I77} Saved Stream = Out Stream

!VAX! Saved Default = Current Default
!VAX! Set Default (".PSS")
!VAX! Open Binary Output (3, File String)
!VAX! Set Default (Saved Default)

{APM} Open Output (3, File String . ".PSS")

{I77} Select Output (3)

{I77} FA = Addr (Block (0))

   INTEGER (FA) = M'PLGS'          {Mark with tag and version no}
   INTEGER (FA + 4) = SAVE VERSION                  

   SAVE AD = FA + 8

   SAVE V (LAT, 13)
   SAVE V (ATOM0, 6)
   SAVE V (LIST10, 1)
   SAVE V (FHPP, 4)
   SAVE V (BRKP, 1)
   SAVE V (FILE ERRORS, 1)

{I77} Write Memory (FA, 256)      {Save descriptor block}

         {copy stacks to file}
         K=ADDR(LAT)                               {Start of Lxx, Rxx pairs}
         %for I = 0, 1, 5 %cycle                   {There are six stacks}
            L=INTEGER(K)                           {Length in bytes}

!EMAS!      L=L>>3                                 {In 8 byte units}
!EMAS!      INTEGER (K) = L
!EMAS!      R = INTEGER (K + 4) + FA

            K = K + 8                                  {Move to next pair}
            S = INTEGER (ADDR (ATOM0) + I*4)           {Base of stack (Source)}

!EMAS!      %WHILE L > 0 %CYCLE
!EMAS!         Long Integer (R) = Long Integer (S)   {Copy into SM file}
!EMAS!         R = R + 8                             {Move on in File}
!EMAS!         S = S + 8                             {Move on Source}
!EMAS!         L = L - 1                             {Decrease Length}
!EMAS!      %REPEAT

{I77}       Write Memory (S, L)

         %REPEAT

!EMAS!   CLOSESM(11)
!EMAS!   DISCONNECT(File String)

{I77}    Close Output
{I77}    Select Output (Saved Stream)

   RESTORE VARS
   %RESULT=1
%END {Save}

{-RESTORE-}

%integer %function Restore (%string (127) SFILE)
   %own %integer P ATOM,               {Shadow stack bases}
                 P AUXSTK,
                 P TR,
                 P SKEL,
                 P GLB,
                 P LCL

   %own %INTEGER R ATOM,               {Relocation values for the stacks}
                 R AUXSTK,
                 R TR,
                 R SKEL,
                 R GLB,
                 R LCL
   %own %INTEGER FA,
                 I,
                 SAVEP,
                 P,
                 P1,
                 P2,
                 S,
                 T,
                 R,
                 L

{I77} %integer Saved Stream
!VAX! %string (127) Saved Default

{I77} %byte %array Block (0 : 255)

   {REMAP}
   
   %ROUTINE REMAP (%INTEGER TP)
      ! remap source term pointed to by TP
      %INTEGER T,N

      T = INTEGER (TP)
      %RETURN %IF T < P ATOM
      INTEGER (TP) = T + R ATOM %AND %RETURN %IF T < P SKEL
      INTEGER (TP) = T + R LCL %AND %RETURN %IF T >= P LCL
      INTEGER (TP) = T + R GLB %AND %RETURN %IF T >= P GLB
      INTEGER (TP) = T + R SKEL
      TP = INTEGER (TP)
      T = INTEGER (TP) + R SKEL
      INTEGER (TP) = T
      N = BYTE INTEGER (T + ARITY OF FE)
      %WHILE N > 0 %CYCLE
         TP = TP + 4
         REMAP (TP)
         N = N - 1
      %REPEAT
   %END {Remap}

{I77} %on 9 %start
{I77}    Select Input (Saved Stream)

!VAX!    Set Default (Saved Default)

{I77}    Error Mes = Event_Message
{I77}    %result = 0
{I77} %finish

   {-MAIN CODE OF RESTORE-}

   ! connect file

!EMAS!   DEFINE("11,".SFILE)
!EMAS!   FA=SMADDR(11,I)
!EMAS!   %IF RETURN CODE # 0 %START
!EMAS!      ERROR MES=SSFMESSAGE
!EMAS!      %RESULT=0
!EMAS!   %FINISH

{I77}    Saved Stream = In Stream

!VAX!    Saved Default = Current Default
!VAX!    Set Default (".PSS")
!VAX!    Open Binary Input (3, S File)
!VAX!    Set Default (Saved Default)

{APM}    Open Input (3, S File . ".PSS")

{I77}    Select Input (3)

{I77}    FA = Addr (Block (0))
{I77}    Read Memory (FA, 256)

   ! check it is a saved prolog state
   %IF INTEGER (FA) # M'PLGS' %START
      ERROR MES = "** File ".SFILE." is not a saved prolog state"

!EMAS!CLOSESM(11)

{I77} Close Input
{I77} Select Input (Saved Stream)

      %RESULT = 0
   %FINISH
   ! check version
   %IF INTEGER (FA + 4) # SAVE VERSION %START
      ERROR MES="** File ".SFILE. " is not compatible with this Prolog version"

!EMAS!CLOSESM(11)

{I77} Close Input
{I77} Select Input (Saved Stream)

      %RESULT=0
   %FINISH

   SAVEAD = FA + 56
   RSTRV (SAVE P, 1)
   RSTRV (P ATOM, 6)             {Restore shaddow stack bases}
   RSTRV (LIST10, 1)             {Stack pointers}
   RSTRV (FHPP, 4)
   RSTRV (BRKP, 1)
   RSTRV (FILE ERRORS, 1)

   {compute relocation constants}
   P1 = ADDR (ATOM0)              {Base address of new stacks}
   P2 = ADDR (P ATOM)             {Base address of old stacks}
   P  = ADDR (R ATOM)             {pointer to relocation constants}
   %for I = 1, 1, 6 %cycle
      INTEGER (P) = INTEGER (P1) - INTEGER(P2)
      P = P + 4                   {Bump pointers}
      P1 = P1 + 4
      P2 = P2 + 4
   %REPEAT

   ! extract stacks from file
   P1 = FA + 8                      {Points at Lxx and Rxx pairs}
   P2 = ADDR (ATOM0)                {Pointer Pointer to base of new stacks}
   %for I = 1, 1, 6 %cycle
      L = INTEGER (P1)              {Length of thing Lxx}
            {in I77  - Bytes}
            {on EMAS - Eight Byte Long Integers}
      T = INTEGER (P2)              {Where to put it}

!EMAS!S = INTEGER (P1 + 4) + FA     {Source Rxx plus base}
!EMAS!%WHILE L > 0 %CYCLE
!EMAS!   Long Integer (T) = Long Integer (S)
!EMAS!   T = T + 8
!EMAS!   S = S + 8
!EMAS!   L = L - 1
!EMAS!%REPEAT

{I77} Read Memory (T, L)

      %IF I # 1 %AND %c
          I # 4 %START
         {If it is not Atom or skel}
         ! relocate stack contents
!EMAS!   L = INTEGER (P1)<<1           {Convert from 8 bytes to 32 bit integers}
!VAX!    L = Integer (P1)>>2           {Convert bytes to 32 bit integers}
{APM}    L = Integer (P1)>>2           {Convert bytes to 32 bit integers}
         S = INTEGER (P2)
         %WHILE L > 0 %CYCLE
            K = INTEGER (S)
            %IF K < PTR %START
               %IF K >= P AUXSTK %start
                  K = K + R AUXSTK
               %ELSE
                  K = K + R ATOM %IF K >= P ATOM
               %FINISH
            %ELSE
               %IF K >= P GLB %START
                  %IF K >= P LCL %THEN K = K + R LCL %c
                                 %ELSE K = K + R GLB
               %ELSE
                  %IF K >= P SKEL %THEN K = K + R SKEL %c
                                  %ELSE K = K + R TR
               %FINISH
            %FINISH
            INTEGER (S) = K
            S = S + 4
            L = L - 1
         %REPEAT
      %FINISH
      P1 = P1 + 8                      {Bump Lxx and Rxx pointer}
      P2 = P2 + 4                      {Bump new stacks pointer pointer}
   %REPEAT

!EMAS!   CLOSESM(11)
!EMAS!   DISCONNECT(SFILE)

{I77}    Close Input
{APM}    Select Input (0)  
!VAX!    Select Input (Saved Stream)

   SAVE AD = SAVE P + LCL0             {Lift global variables from LCL}
   RSTRV (ATOM NIL, RQRD ATOMS)
   RSTRV (CALL TAG, RQRD FUNCS)
   RSTRV (AT PROMPT, 1)
   RSTRV (BRK LEV, 1)
   RSTRV (ATOM FP, 1)
   BRKP = BRKP + R LCL
   RESTORE VARS

   {remap free space chains}
   FHPP = FHPP + R SKEL
   K = ADDR (HEAP FREE 2)
   %WHILE INTEGER (K) # 0 %CYCLE
      INTEGER (K) = INTEGER (K) + R SKEL
      K = INTEGER (K)
   %REPEAT
   K = ADDR (HEAP FREE)
   %WHILE INTEGER (K) # 0 %CYCLE
      INTEGER (K) = INTEGER (K) + R SKEL
      K = INTEGER (K)
      P1 = K
      %WHILE INTEGER (P1) # 0 %CYCLE
         INTEGER (P1) = INTEGER (P1) + R SKEL
         P1 = INTEGER (P1)
      %REPEAT
      K = K + 4
   %REPEAT
   REMAP (ADDR (LIST 10))
   SET PLPROMPT (STRING (ATPROMPT + ST OF AE))

   {remap atom and heap areas}
   HASHA = ATOM0
   %for K = HASHA, 4, HASHA + 508 %cycle
      P = K
      {remap hash chain}
      %WHILE INTEGER (P)  #0 %CYCLE
         {remap arity chain}
         P1 = P
         %WHILE INTEGER (P1) # 0 %CYCLE
            T = INTEGER (P1)
            %IF T < PSKEL %THEN T = T + R ATOM %c
                          %ELSE T = T + R SKEL
            INTEGER (P1) = T; ! remap pointer to entry
            P1 = INTEGER (P1)
            INTEGER (P1) = INTEGER (P1) + R ATOM; ! remap pointer to atom
            ! remap chain of definitions
            P2 = P1 + DEFS OF FE
            %WHILE INTEGER (P2) >= P SKEL %CYCLE
               INTEGER (P2) = INTEGER (P2) + R SKEL
               P2 = INTEGER (P2)
               %EXIT %IF INTEGER (P2 + ALT OF CL) = P2 ;! check for circularity
               REMAP (P2 + HD OF CL)
               REMAP (P2 + BDY OF CL)
               P2 = P2 + ALT OF CL
            %REPEAT

            ! remap data base chain
            P2 = P1 + DB OF FE
            %WHILE INTEGER (P2) >= P SKEL %CYCLE
               INTEGER (P2) = INTEGER (P2) + R SKEL
               P2 = INTEGER (P2)
               T = INTEGER (P2 + HD OF CL); ! remap key pointer
               %IF T < PSKEL %THEN T = T + R ATOM %c
                             %ELSE T = T + R SKEL
               INTEGER (P2 + HD OF CL) = T
               REMAP (P2 + BDY OF CL)
               P2 = P2 + ALT OF CL
            %REPEAT
            %IF P1 >= SKEL0 %start
               T = P1 - R SKEL + GT OF FE 
               REMAP(ADDR (T))
            %finish
            P1 = P1 + NXT OF FE
         %REPEAT
         P = INTEGER (P) + NXT OF AE
      %REPEAT
   %REPEAT

   %RESULT=1
%END {Restore}


%ROUTINE RESET TRAIL(%INTEGER T)
   %WHILE TR#T %CYCLE
      TR=TR-4; K=INTEGER(TR)
      %IF K>=GLB0 %start 
         INTEGER(K)=0
      %ELSE
         BN==BYTEINTEGER(K+INFOFCL)
         %IF BN&ERASEFLAG=0 %start
            BN=0
         %ELSE
            RELEASEC(INTEGER(K+HDOFCL))
            RELEASEC(INTEGER(K+BDYOFCL))
            RELEASEP(K,SZOFCL)
         %FINISH
      %FINISH
   %REPEAT
%END


%constant %integer Ref Bits = 16_80000000,
                   DBIT     = 16_20000000

{-RECORDED-}

%integer %function Recorded (%integer Key)
   !  Key  should be DBOFFE for the data base
   !              or DEFSOFFE for clauses
   ! The local stack is expected to contain
   !     V1OFCF    term to be matched
   !     V2OFCF    var to be unified with reference into data base
   !     V3OFCF    
   !     V4OFCF    indirect pointer to next term to be tried for match
   %INTEGER P,
            SV1,
            V1F,
            T,
            N,
            H,
            B,
            SX,
            TR0

   V = V + 16             {since args of $record(_,_,_) are classified as temp.}
   P = INTEGER (INTEGER(X + V4 OF CF))
   SV1 = V1
   V1F = V1
   TR0 = TR
TRY NEXT:
   %RESULT = 0 %IF P = 0
   N = BYTE INTEGER (P + GV OF CL)
   %WHILE N > 0 %cycle
      Check V1 (4)
      INTEGER (V1) = 0
      V1 = V1 + 4
      N = N - 1 
   %repeat
   %IF KEY = DEFS OF FE %START
      N = BYTE INTEGER (P + LT OF CL)
      T = V
      %WHILE N > 0 %cycle
         INTEGER (T) = 0
         T = T + 4
         N = N - 1 
      %repeat
      H = INTEGER (P + HD OF CL)
      %IF H >= SKEL0 %START
         Check V1 (8)
         INTEGER (V1) = H
         INTEGER (V1 + 4) = SV1
         H = V1
         V1 = V1 + 8
      %FINISH
      B = INTEGER(P + BDY OF CL)
      B = ATOM TRUE %IF B = 0
      %IF B >= SKEL0 %START
         Check V1 (8)
         INTEGER(V1) = B
         INTEGER(V1 + 4) = SV1
         B = V1
         V1 = V1 + 8
      %FINISH
      Check V1 (8)
      INTEGER (V1) = H
      INTEGER (V1 + 4) = B
      V1F = V1
      V1 = V1 + 8
      T = ARROW TAG + GT OF FE
   %ELSE 
      T = INTEGER (P + BDY OF CL)
   %finish
   SX = X
   X = V - 32
   N = UNIFY ARG (SX + V1 OF CF, T, V1F)
   X = SX

   %IF N = 0 %OR %c
       KEY = DEF S OF FE %START
     V1 = SV1
     TR = TR - 4 %AND INTEGER (INTEGER (TR)) = 0 %WHILE TR # TR0
   %FINISH

   P = INTEGER (P + ALT OF CL) %AND -> TRY NEXT %IF N = 0
   INTEGER (X + V4 OF CF) = P + ALT OF CL

   %IF BYTE INTEGER (P + INF OF CL) = 0 %START
     BYTE INTEGER (P + INF OF CL) = IN USE FLAG
     INTEGER (TR) = P
     TR = TR + 4
   %FINISH
   
   P = REFBITS!(P - SKEL0)
   P = P!DBIT %IF KEY = DB OF FE
   N = INTEGER (X + V2 OF CF)
   INTEGER (N) = P
   INTEGER (TR) = N %AND TR = TR + 4 %IF N < VV1 %OR %c
                                       LCL0 <= N < VV
   %RESULT = P
%END {Recorded}


{-INSTANCE-}

%integer %function INSTANCE (%INTEGER R, ARGP)

   %INTEGER RL, TF, P, L, G, H, B
   
   {GLOBALIZE}

   %integer %function GLOBALIZE (%INTEGER T, BODYFLG)
      %INTEGER A, B, N, K

      %RESULT = T %IF T < SKEL0
      %IF BODY FLG # 0 %AND %c
          INTEGER (T) = COMMA TAG %START
         A = GLOBALIZE (INTEGER (T + 4), 0)
         B = GLOBALIZE (INTEGER (T + 8), 1)
         Check V1 (16)
         INTEGER (V1) = A
         INTEGER (V1 + 4) = B
         T = V1 + 8
         INTEGER (T) = COMMA TAG + GT OF FE
         INTEGER (T + 4) = V1
         V1 = V1 + 16
         %RESULT = T
      %FINISH
      N = BYTE INTEGER (INTEGER (T) + ARITY OF FE)
      Size = N*4 + 8
      Check V1 (Size)
      INTEGER (V1) = INTEGER (T) + GT OF FE
      INTEGER (V1 + 4) = V1 + 8
      A = V1
      B = V1 + 8
      V1 = V1 + Size
      %WHILE N>0 %CYCLE
         T=T+4; K=INTEGER(T)
         %IF K >= SKEL0 %START
            %IF K < GLB0 %START
               Check V1 (8)
               INTEGER (V1) = K
               INTEGER (V1 + 4) = TF
               K = V1
               V1 = V1 + 8
            %ELSE
               K = K + RL %IF K >= LCL0
               K = K + TF - GLB0
            %FINISH
         %FINISH
         INTEGER (B) = K
         B = B + 4
         N = N - 1
      %REPEAT
      %RESULT = A
   %END {Globalize}
   
   %RESULT = -1 %IF R&INT0 # REF BITS
   
   P = R&16_0FFFFFFF + SKEL0         {strip of flag bits}

   G = BYTE INTEGER (P + GV OF CL)
   L = BYTE INTEGER (P + LT OF CL)
   RL = G + L;
   TF = V1
   Check V1 (RL*4)
   %WHILE RL > 0 %cycle
      INTEGER (V1) = 0
      V1 = V1 + 4
      RL = RL - 1 
   %repeat
   RL = G * 4 - 32 + GLB0 - LCL0
   %IF R&DBIT # 0 %start
      H = INTEGER (P + BDY OF CL)
   %ELSE
      H = INTEGER (P + HD OF CL)
      B = INTEGER (P + BDY OF CL)
      B = ATOM TRUE %IF B=0
      %IF L > 0 %START
         H = GLOBALIZE (H, 0)
         B = GLOBALIZE (B, 1)
      %ELSE
         %IF H >= SKEL0 %START
            Check V1 (8)
            INTEGER (V1) = H
            INTEGER (V1 + 4) = TF
            H = V1
            V1 = V1 + 8
         %FINISH
         %IF B >= SKEL0 %START
            Check V1 (8)
            INTEGER (V1) = B
            INTEGER (V1 + 4) = TF
            B = V1
            V1 = V1 + 8
         %FINISH
     %FINISH
     Check V1 (8)
     INTEGER (V1) = H
     INTEGER (V1 + 4) = B 
     H = ARROW TAG + GT OF FE
     TF = V1 
     V1 = V1 + 8
   %FINISH
   %RESULT = UNIFY ARG (ARGP,H,TF)
%END {Instance}

{-B READ-}

{read initialization terms}

%integer %function BREAD
   %INTEGER R

   %ON 9 %START
      %RESULT = END OF FILE
   %FINISH

   %cycle
      V = LCL0
      V1 = GLB0
      SET PLPROMPT("    >> ")
      PROMPT      ("Boot>> ")
      VARFP = VRZ
      LSP = V
      LSZ = LSP + 1000
      READING = 0
      R = Read Term
      %RESULT = R %IF R # 0
   %repeat
%END {B Read}

{-------------------------MAIN CODE OF PROLOG----------------------------------}

%switch Event Case (0:10)

%on 1, 2, 13, 14 %start
{I77}   Prolog Event = 4 %if Event_Event = 1
{I77}   Prolog Event = 4 %if Event_Event = 2
{I77}   %if Event_Event = 14 %start        {Edwin error}
{I77}      Error Mes = "! Edwin Error: " . Edwin Error (Event_Sub)
!EMAS!  %if ??? = 14 %start
!EMAS!     Error Mes = "! Edwin Error: " . Edwin Error (???)
           Prolog Event = 5
        %finish
%finish

->EVENT CASE (PROLOG EVENT)

                         ! Prolog event handling
                         !  (IMP level events are mapped to Prolog events,
                         !   SIGNAL PROLOG EVENT(..) can also be used to force
                         !   a Prolog event to occur.

EVENT CASE(1):   ! abort
ABORT:
   New Lines (2)
   Print String("[Execution aborted]")
   New Lines (2)
   RESET TRAIL(TRBASE)
   CLOSE FILES
   INIT IO

{APM} Control Y Trap = 1

   -> RESTART

EVENT CASE(2): ! files error
IO FAILURE: 
   -> EFAIL %IF FILE ERRORS = 1
   DEBUG = 1
   NEW LINES (2)
   Print String (ERROR MES)
    New Lines (2)
    -> EFAIL

EVENT CASE(3): ! input ended
   SELECT INPUT(0)
   CLOSE STREAM (INPUT)
   %IF INPUT # 0 %start
      FILE STATE (INPUT) = 0 
   %finish
   INPUT = 0
   %IF READING = 1 %start 
      READING = 0
      -> READ END
   %else %if Reading = 2 
      Reading = 0
      -> Get End
   %else %if Reading = 3
      Reading = 0
      -> Debug End
   %finish
   ERROR MES="! Input ended "
   ->IO FAILURE

EVENT CASE(4): ! error in arithmetic expression
   Select Output (0)
   New Line
   Print String("! error in arithmetic expression");
   New Line
   DEBUG=1
   SKLEV=10000000
   ->EFAIL

EVENT CASE(5): ! General error with message requiring abort
  SELECT OUTPUT(0)
  New Line
  Print String(ERROR MES)
  -> ABORT

EVENT CASE(0): ! Cold start

{----------------------------PROLOG COLD START---------------------------------}

Print String ("Imp Prolog ")

!VAX! Print String ("VAX/VMS")
!EMAS!Print String ("2900 EMAS")
{APM} Print String ("APM")

PRINT STRING(" Version, Release "); WRITE (VERSION, 0)
NEW LINE

Create Stacks

!VAX! Can Ctrl C
!VAX! On Ctrl C (Trap Control C)

!EMAS!SSFOFF

!VAX! Set Default (".PSS")

%IF Options&Bootstrap Option = 0 %START
   %IF PL File = "" %START
!EMAS!%IF Exist ("PL#INIT")#0 %start 
{I77} %IF Exists ("Init") %start 
         PL File = "Init"
      %ELSE 
         PL File = STANDARD STARTUP 
         Options = Options!Quiet Option
      %FINISH
   %else
!EMAS!%if Exist (PL File)=0 %start
!VAX! %unless Exists (PL File) %start
{APM} %unless Exists (PL File . ".PSS") %start
         PRINTSTRING("** File ". PL File ." does not exist"); NEWLINE
         %RETURN
      %finish
   %finish
   %IF Options&Quiet Option = 0 %START
      PRINTSTRING("[Restoring file ".PL File."]")
      NEWLINE
   %FINISH
   %IF RESTORE (PL File) # 0 %START
      INIT IO
      RUNNING = 1                      {The system is now up and running}

{APM} Control Y Trap = 1               {Stop ^Y exiting}

      -> ECONT %IF BRKLEV=0
      Print String ("[Restarting Break (level ")
      B WRITE (BRK LEV,0)
      Print String (")]")
      New Line
      -> ECONT
   %FINISH
   Print String (ERROR MES)
   New Line
   %RETURN
%FINISH

PL File = BOOTFILE %IF PL File=""
!EMAS!%if Exist (PL File)=0 %START
{I77} %unless Exists (PL File) %START
  PRINTSTRING("** File ".PL File." does not exist"); NEWLINE
  %RETURN
%FINISH

PRINTSTRING("[Bootstrapping Session.  Initialising from file ".PL File."]")
NEWLINE

! initialize atom area
HASHA = ATOM0
ATOM FP = ATOM0
%for K = 1, 1, 128 %cycle
  INTEGER (ATOM FP) = 0
  ATOM FP = ATOM FP + 4
%REPEAT

! initialize read/print vars
 LC = 1
 QUOTE IA = 0 

! initialize Auxstack, Trail and Heap areas
 FHPP = SKEL0
 HEAP FREE = 0
 HEAP FREE 2 = 0
 HEAP USED = 0

! initialise I/O system
INIT IO
FILE ERRORS = 0
TO SEE = 0
To Close = 0

! Junk (otherwise unititialised)

BRKP = 0
CH = 0
GF = 0
L = 0
N = 0
PORT = 0
RECONS = 0
SPY =0

! Now load bootstrap file information

!EMAS! DEFINE("1,".PL File)

{I77} Open Input(1, PL File)
{I77} File Direction (1) = Being Seen

SELECTINPUT(1)
INPUT=1
FILESTATE(1)=1

{read required atoms}
K1=ADDR(ATOMNIL)
%for K=1,1,RQRDATOMS %cycle
  INTEGER(K1)=BREAD
  K1=K1+4
%REPEAT

{read required functors}
K1=ADDR(CALLTAG)
%for K=1,1,RQRDFUNCS %cycle
  INTEGER(K1)=INTEGER(INTEGER(BREAD))
  K1=K1+4
%REPEAT

{create term LIST10}
LIST10=GETSP(108)
K1=LIST10
%for K = 9, -1, 1 %cycle
  INTEGER (K1) = LIST FUNC
  INTEGER (K1 + 4) = GLB0 + K*4
  INTEGER (K1 + 8) = K1 + 12
  K1 = K1 + 12
%REPEAT
INTEGER (LIST10 + 104) = GLB0

AT PROMPT = ATOM NIL
RUNNING = 1                               {Boot is now running}

{-------------------------------RESTART-------------------------------}

{Restart here after an abort etc.}

RESTART:

VRZ = AUXSTK0
TR = TRBASE
V = LCL0
V1 = GLB0
FILE NAME (0) = USER
DEBUG = 0
EXEC SYS = 0
LEASH = 2_101
   BRK LEV = 0

   PG = LIVE %AND ->GO %IF Options&Bootstrap Option = 0   {If not bootstraping}

{Main loop during bootstrap session}

MAIN LOOP: 
   PG=BREAD

   %IF PG >= GLB0 %AND %c
       INTEGER (PG) # 0 %THEN G = INTEGER (PG) %c
                        %ELSE G = PG

   %IF G = END OF FILE %START
      SELECT INPUT (0)
      FILE STATE (INPUT) = 0 %AND CLOSE STREAM (INPUT) %IF INPUT#0
      INPUT=0
      Options = Options&(\Bootstrap Option)     {Cancel bootstrap}
      -> RESTART   {no longer bootstrapping}
   %FINISH

   %IF G<SKEL0 %OR %c
       INTEGER(G)#PROVEFUNC %START

      K = RECORD (DEFS OF FE, PG, 0, 0)

      %IF K=0 %START
         Print String (ERROR MES)
         New Line
         P WRITE (PG, 0, 1200)
         New Line
      %FINISH

      ->MAIN LOOP
   %FINISH

   SET PLPROMPT("| ")
   PG = ARG (G + 4, INTEGER (PG + 4))

{-------------------------------------GO---------------------------------}

GO: 
   TR = TRBASE
   VV = 0
   VV1 = 0
   C = 1
   LEV = 1
   INVOK NO = 0
   SK LEV = 1000000
   -> ICALL

YES:  
   RESET TRAIL(TRBASE)
   -> MAIN LOOP

NO: 
   PRINT STRING("no.")
   NEW LINE
   -> MAIN LOOP

!******************************************************************************

!          INTERPRETER MAIN LOOP

!******************************************************************************

ICALL: 
   %IF PG < GLB0 %start 
      G = PG 
   %ELSE 
      X1 = INTEGER (PG + 4)
      G = INTEGER (PG)
   %finish

   F = INTEGER(G)

   D = INTEGER (F + DEFS OF FE)

   INFO = INT0 %AND -> KEEP CALLING %IF EXEC SYS # 0

   B = BYTE INTEGER (F + FLGS OF FE)
   %if B&Sys Flgs # 0 %start
      %if B&SYS FLGT # 0 %start
         Lev = Lev - 1 %IF D >= SKEL0
         Info = (Invok No<<Lev W)!LEV!16_80000000
         -> KEEP CALLING
      %finish
      Invok No = Invok No + 1
      Info = (Invok No<<Lev W)!Lev!16_80000000
      Exec Sys = Exec Sys Flg
   %else
      Invok No = Invok No + 1
      Info = (Invok No<<Lev W)!Lev!16_80000000
   %finish
   
{APM} %if Control Y Trap&2_1000 0000 # 0 %start
{APM}    Control Y Trap = 1

!VAX! %if Control C Trapped # 0 %start
!VAX!    Control C Trapped = 0

         %if Take Interrupt Action = 1 %start
            ! abort
            Signal Prolog Event (1) 
         %else %if Take Interrupt Action = 2
            ! break
            BRTN = 1
            BG = BREAK
            Select Input (Input)
            -> L BREAK
         %finish
      %finish

    -> TRACE CALL %IF DEBUG # 0
   
KEEP CALLING:

   -> EFAIL %IF D=0

   -> STD PRED(D) %IF D<255
   
   INTEGER (V + LCP OF CF) = VV
   INTEGER (V + G OF CF) = PG
   INTEGER (V + GF OF CF) = X
   INTEGER (V + GS OF CF) = V1
   INTEGER (V + TR OF CF) = TR
   TR0  =  TR
   INTEGER (V + INF OF CF) = INFO
   INTEGER (V + C OF CF) = C
   VV = V
   VV1 = V1
   
   {Try one clause}
   
ALT: 
   %IF G >= SKEL0 %THEN ARG1 = ARGV (G + 4, X1, K) %c
                  %ELSE ARG1 = LCL0

ALT1: 
   -> Try CLS %IF ARG1 >= GLB0

   %IF ARG1 >= SKEL0 %START
      %cycle
         B = INTEGER (INTEGER (D + HD OF CL) + 4)

         -> TRY CLS %IF B >= GLB0

         -> TRY CLS %IF B >= SKEL0 %AND %c
                        INTEGER (B) = INTEGER (ARG1)
   
         D = INTEGER (D + ALT OF CL)
      %repeat %until D = 0
      VV = INTEGER (V)
      -> EFAIL
   %FINISH

   %cycle
      B = INTEGER (INTEGER (D + HD OF CL) + 4)
      -> TRY CLS %IF B >= GLB0 %or %c
                     B = ARG1
      D = INTEGER (D + ALT OF CL)
   %repeat %until D = 0
   VV = INTEGER (V)
   ->EFAIL

TRY CLS:  
   FL = D + ALT OF CL
   V1F = V1

   %IF DEBUG=0 %AND %c
       INTEGER(FL)=0 %START
     VV = INTEGER (V)
     VV1 = INTEGER (VV + GSOFCF) %IF VV # 0
   %FINISH

   {Clear Global Variables to 0 (GV)}
   K = BYTE INTEGER (D + GV OF CL)
   %WHILE K # 0 %cycle
      Check V1 (4)
      INTEGER (V1) = 0
      V1 = V1 + 4
      K = K - 1 
   %repeat

   {Clear Local and Temp variables  (LT)}
   K1 = V + V1 OF CF
   K = BYTE INTEGER (D + LT OF CL)
   %WHILE K # 0 %cycle
      INTEGER (K1) = 0 
      K1 = K1 + 4
      K = K - 1 
   %repeat
   INTEGER (V + ALT OF CF) = FL

                      {Goal                    Global Frame}
   -> FAIL %IF GUNIFY (INTEGER (D + HD OF CL), V1F, 
                       G,                      X1) = 0
   
   BN == BYTE INTEGER (D + INF OF CL)
   %IF BN&IN USE FLAG = 0 %START
      BN = BN!IN USE FLAG
      INTEGER (TR) = D
      TR = TR + 4
   %FINISH
   
   %IF INTEGER (D + BDY OF CL) = 0 %START
      PG = INTEGER (V + G OF CF)
      Size = SZ OF CF + BYTE INTEGER (D + LV OF CL)<<2
      No Space ("LOCAL") %if V + Size > Local Limit
      V = V + Size 
      -> NECK FOOT
   %FINISH
   
   C = INTEGER (D + BDY OF CL)
   X = V
   X1 = V1F
   Size = SZ OF CF + BYTE INTEGER (D + LV OF CL)<<2
   No Space ("LOCAL") %if  V + size > Local Limit
   V = V + Size
   LEV = LEV + 1

   %IF C < 0 %start 
      K = C&255
      C = 0
      -> STD PRED (K)
   %finish

   -> NOT FOOT


! Continuation Handling

NOTFOOT:
  PG=C %AND C=0 %AND -> ICALL %IF INTEGER(C)#COMMATAG
  PG=INTEGER(C+4)
  C=INTEGER(C+8)
  ->ICALL

CONTINUATION: 
ECONT:
 ->NOTFOOT %IF C#0
 V=X %IF X>VV

 C=INTEGER(X+COFCF);
 INFO=INTEGER(X+INFOFCF); PG=INTEGER(X+GOFCF)
 LEV=INFO&MASKLEV
 EXECSYS=INFO&EXECSYSFLG
 X=INTEGER(X+GFOFCF)
NECK FOOT:
  ->YES %IF C=1; !**BOOT** only
 X1=INTEGER(X+GSOFCF)
 ->CONTINUATION %IF EXECSYS#0 %OR DEBUG=0
 ->TRACEEXIT

NIY:
   Print String ("Not yet implemented")
   New line
   -> EFail

!  Shallow backtracking
FAIL: D=INTEGER(FL)
TR=TR-4 %AND INTEGER(INTEGER(TR))=0 %WHILE TR#TR0
 V1=V1F %AND ->ALT1 %IF D#0
! deep backtracking
EFAIL:
 %CYCLE
   ->NO %IF VV=0 ; ! ** Boot only **
   D = INTEGER (INTEGER (VV + ALT OF CF))
   %EXIT %IF D#0
   VV=INTEGER(VV)
 %REPEAT

 V=VV
 V1=INTEGER(V+GSOFCF)
 VV1=V1
 X=INTEGER(V+GFOFCF)
 PG=INTEGER(V+GOFCF)
 TR0=INTEGER(V+TROFCF)
 %WHILE TR#TR0 %CYCLE
  TR=TR-4; K=INTEGER(TR)
  %IF K>=GLB0 %start
     INTEGER(K)=0
  %ELSE
    BN==BYTEINTEGER(K+INFOFCL)
    %IF BN&ERASEFLAG=0 %start 
       BN=0
    %ELSE
       RELEASEC(INTEGER(K+HDOFCL))
       RELEASEC(INTEGER(K+BDYOFCL))
       RELEASEP(K,SZOFCL)
   %FINISH
 %FINISH
%REPEAT

 INFO=INTEGER(V+INFOFCF); LEV=INFO&MASKLEV; EXECSYS=INFO&EXECSYSFLG

 C=INTEGER(V+COFCF)
 %IF  PG<GLB0 %START
   G=PG;  X1=INTEGER(X+GSOFCF)
   ->ALT  %IF EXECSYS#0 %OR DEBUG=0
   -> TRACE BACK {BOOT only}
 %FINISH
 G=INTEGER(PG); X1=INTEGER(PG+4)
 ->ALT %IF EXECSYS#0 %OR DEBUG=0
 ->TRACEBACK


!***********************************************************************
!*
!*      BOOT  debugging package
!*
!***********************************************************************
TRACE CALL:
  -> KEEP CALLING %IF LEV > SK LEV %AND SPY = 0       {ignore this call}
  PORT = CALLPORT
  GF = X1
  ->TRACE CE

TRACE EXIT:
  ->CONTINUATION %IF LEV>SKLEV %AND SPY=0
  %IF PG>=GLB0 %START
     G=INTEGER(PG); GF=INTEGER(PG+4)
  %ELSE
     G=PG; GF=X1
  %FINISH
  PORT=EXITPORT
  F=INTEGER(G); B=BYTEINTEGER(F+FLGSOFFE)

TRACE CE:
  ->ACTION (PORT) %IF B&TRACE FLAG # 0 %OR %C
                     (LEV > SKLEV %AND %c
                      B&SPY FLAG = 0)
  -> MESSAGE

TRACEBACK:
  ->ALT %IF SKLEV<LEV %AND SPY=0
  %IF PG<GLB0 %START
     G=PG; GF=X1
  %FINISH %ELSE %START
     G=INTEGER(PG); GF=INTEGER(PG+4)
  %FINISH
  PORT=BACKTOPORT
  F=INTEGER(G); B=BYTEINTEGER(F+FLGSOFFE)
  ->ALT %IF B&TRACEFLAG#0 %OR (LEV>SKLEV %AND B&SPYFLAG=0)

MESSAGE:
   %IF B&SPY FLAG # 0 %THEN Print Symbol ('*') %c
                      %ELSE Print Symbol (' ')
   %IF LEV = SK LEV %THEN Print Symbol ('>') %c
                    %ELSE Print Symbol (' ')
   Print String(" (")
   B WRITE ((INFO>>LEVW)&MASK INV K, 0)
   Print String(") ")
   B WRITE (INFO&MASK LEV, 0)
   Print Symbol (' ')
   Print String (PORT NAME (PORT))
   P WRITE(G, GF, 999)
   New Line
   -> ACTION (PORT) %IF LEASH&(1<<(3 - PORT)) = 0
   Select Input (0)
   PROMPT("Debug: ")
   Reading = 3
   GETC (CH)
   CH2 = CH
   %unless Ch = 'j' %start
      GETC (CH2) %WHILE CH2 # NL
   %finish
   Reading = 0
   PROMPT (PLPROMPT)
   
   CH = CH - 'A' + 'a' %IF 'A' <= CH <= 'Z' 
   
%IF CH = NL %OR %c
    CH='c' %START 
  ! creep
  SK LEV = 1000000
  SPY = 0
  -> ACTION (PORT)
%FINISH

%IF CH='l' %START  
  ! leap
  SK LEV = INFO & MASK LEV
!!!  SK LEV = 0            ?????????
  SPY = 1
  Select Input (Input)
  ->ACTION(PORT)
%FINISH

%IF CH='s' %START  
  ! skip           
  -> NO TAPP %IF PORT=EXITPORT
  SK LEV = INFO & MASK LEV
  SPY = 0
  -> ACTION (PORT)
%FINISH

%if Ch = 'j' %start
   ! Jump
   Prompt ("Level: ")
   Read (Sk Lev)
   GETC (CH2) %until CH2 = NL
   Spy = 0
   -> Action (Port)
%finish

%IF CH='q' %START  
  ! quasi-skip
  ->NOTAPP %IF PORT=EXITPORT
  SKLEV=INFO&MASKLEV
  SPY=1
  ->ACTION(PORT)
%FINISH

%IF CH='r' %START  
  ! retry   ** not yet implemented **
 ->NOTAPP
!!!  SPY=0; SKLEV=1000000
!!!  Select Input (Input)
!!!  ->ICALL
%FINISH

%IF CH='f' %START  
  ! fail
   VV = INTEGER(X)
   SPY = 0
   SK LEV = 1000000
   Select Input (Input)
   ->EFAIL
%FINISH

%if Ch='a' %start
Debug End:
   -> ABORT 
%finish

%IF CH='b' %START
  ! break
  BRTN=2
  BG=BREAK
  Select Input (Input)
  -> L BREAK
%FINISH

%IF CH='h' %START
   PRINTSTRING("
 <cr>  creep           a  abort
 c     creep           f  fail
 l     leap            b  break")
   Print String ("
 s     skip            h  help
 q     quasi-skip      n  nodebug
 j <n> jump
")
  ->MESSAGE
%FINISH

%IF CH='n' %START     
  ! turn debug mode off
  DEBUG=0
  -> ACTION (PORT)
%FINISH

   PRINT STRING ("** Unknown option (h for help)")
   NEWLINE
   -> MESSAGE

NOTAPP: 
   PRINTSTRING("** Option not applicable at this port"); NEWLINE
   ->MESSAGE

ACTION(1): 
   Select Input (Input)
   ->KEEPCALLING
ACTION(2): 
   Select Input (Input)
   ->CONTINUATION
ACTION(3): 
   Select Input (Input)
   ->ALT

!   end of debugging code

!***********************************************************************

!-----------------------------------------------------------------------

!   control predicates

STD PRED (6): ! conjunction A,B      a6
K=ARG(G+8,X1)
%IF GLB0 > K >= SKEL0 %START
  Check V1 (8)
  INTEGER(V1) = K
  INTEGER(V1 + 4) = X1
  K = V1
  V1 = V1 + 8
%FINISH
Check V1 (12)
INTEGER(V1)=K
INTEGER(V1 + 4) = CALL TAG + GT OF FE
INTEGER(V1 + 8) = V1
K = V1 + 4
V1 = V1 + 12
%IF C=0 %THEN C=K      %C
%ELSE%START
  INTEGER(V)=COMMATAG; INTEGER(V+4)=K; INTEGER(V+8)=C
  C=V; V=V+12
%FINISH
! exit is via call(A).

STD PRED (1): ! call(A)
   PG = ARG (G + 4, X1)
   ->EFAIL %IF PG < 0 %OR %c
               INTEGER (PG) = 0
   %IF GLB0 > PG >= SKEL0 %START
      Check V1 (8)
      INTEGER (V1) = PG
      INTEGER (V1 + 4) = X1
      PG = V1
      V1 = V1 + 8
   %FINISH
   ->ICALL

STD PRED (2): ! cut operator
CUT:
   -> Continuation %IF X > VV
   VV = INTEGER (X)
   VV1 = INTEGER (VV + GS OF CF) %IF VV # 0
   -> Continuation %IF INTEGER (X + TR OF CF) = TR
   Y = INTEGER (X + TR OF CF)
   P = TR
   TR = Y
   %CYCLE
      K = INTEGER (Y)
      %IF K <= VV1 %OR %c
          LCL0 <= K <= VV %start 
         INTEGER (TR) = K 
         TR = TR + 4
      %finish
      Y = Y + 4
   %REPEAT %UNTIL Y = P 
   -> CONTINUATION

STD PRED (3): ! repeat           b3
 VV=X
 VV1=X1
 INTEGER(FL)=D
 ->CONTINUATION

STD PRED (4): ! abort             a4
   ->ABORT

STD PRED (5): !  $call1(X)
PG=ARG(G+4,X1)
C=INTEGER(X+COFCF); X=INTEGER(X+GFOFCF)
->EFAIL %IF PG<0 %OR INTEGER(PG)=0
%IF GLB0>PG>=SKEL0 %START
  Check V1 (8)
  INTEGER (V1) = PG
  INTEGER (V1 + 4) = X1
  PG = V1
  V1 = V1 + 8
%FINISH
->ICALL


!-----------------------------------------------------------------------

!           i/o predicates  

STD PRED (10): ! see(F)
   TO SEE = 1 
   N = Look File 
   TO SEE = 0
   -> E Cont %IF N = INPUT
   %IF FILE STATE (N) = 2 %START
      %IF OUTPUT = N %start 
         OUTPUT = 0
         SELECT OUTPUT (0)
      %finish
!EMAS!CLOSE STREAM (0)
   %FINISH
   FILE STATE (N) = 1 %IF N # 0
   SELECT INPUT (N)
   INPUT = N
   -> ECONT

STD PRED (11): ! seeing(X)
   K = FILE NAME (INPUT)
   -> UNIFY ATOM

STD PRED (12): ! seen
   -> E Cont %IF INPUT = 0
   SELECT INPUT (0)
   CLOSE STREAM (INPUT)
   FILE STATE (INPUT) = 0
   INPUT = 0
   -> ECONT

STD PRED (13): ! tell(F)
   N=Look File
   -> ECONT %IF N=OUTPUT
!EMAS!   %IF FILESTATE(N)=1 %START
!EMAS!      %IF INPUT=N %start 
!EMAS!         INPUT=0
!EMAS!         SELECT INPUT(0)
!EMAS!      %finish
!EMAS!      CLOSE STREAM(0)
!EMAS!   %FINISH
   FILE STATE (N)=2 %IF N#0
   OUTPUT = N
   SELECT OUTPUT(N)
   -> ECONT

STD PRED (14):! telling(X)
   K = FILE NAME (OUTPUT)
UNIFY ATOM: 
   ! unify atom K with arg in v1ofcf
   K1 = INTEGER (X + V1 OF CF)
   %IF K1 >= GLB0 %AND INTEGER (K1)=0 %START
      INTEGER(K1)=K
      INTEGER(TR)=K1 %AND TR=TR+4 %IF K1<VV1 %OR LCL0<=K1<VV
      ->ECONT
   %FINISH
   ->EFAIL %IF K#K1
   ->ECONT

STD PRED (15): ! told            b15
   ->ECONT %IF OUTPUT=0
   SELECT OUTPUT (0)
   CLOSE STREAM (OUTPUT)
   FILE STATE (OUTPUT)=0
   OUTPUT = 0
   -> ECONT

STD PRED (16): ! close(F)
   To Close = 1
   N = Look File
   To Close = 0
   %if N > 0 %start
      %IF File State (N)=1 %OR %c
         File State (N)=2 %START
         Close Stream (N)
         File State (N) = 0
      %FINISH
   %finish
   -> ECONT

STD PRED (17): !  read(X)
   VAR FP = VRZ
   LSP = V + 12
   LSZ = LSP + 1000
   VAR CHAIN = 0
   READING = 1
   K = READ Term
READ UNIFY:  
   READING = 0
   -> EFAIL %IF K = 0
   -> EFAIL %IF UNIFY ARG (X + V1 OF CF, K, 0) = 0
   -> ECONT

READ END: !  input ended trapped while reading
  K = END OF FILE
  -> READ UNIFY

STD PRED (18): ! write(X)        b18
 QUOTE IA = 0
 P WRITE (INTEGER (X + V1 OF CF), X1, 1200)
 -> ECONT

STD PRED (28): ! writeq(X)        b28
 QUOTE IA = 1
 P WRITE (INTEGER (X + V1 OF CF), X1, 1200)
 ->ECONT

STD PRED (19):! nl         b19
 New Line
 ->ECONT

STD PRED (20): ! get0(N)     b20
   Reading = 2
   GETC (CH)
   Reading = 0
   K = INT0 ! CH
   ->UNIFY ATOM

Get End:
   {land here (out of the blue) on end of input}
   K = Int0 ! 26           {return Control Z as end of input}
   -> Unify Atom

STD PRED (21):! get(n)   b21
 GETC (CH) %UNTIL 32 <= CH <= 127
 K = INT0 ! CH
 -> UNIFY ATOM

STD PRED (22): ! skip(N)  b22
 K1 = INTVAL (X + V1 OF CF)
 GETC (CH) %UNTIL CH = K1
 -> ECONT

STD PRED (23):! put(N)      b23
 K = INT VAL (X + V1 OF CF)
 Print Symbol(K)
 -> ECONT

STD PRED (24):! tab(N)          b24
 K = INT VAL (X + V1 OF CF)
 Print Symbol (' ') %and K = K - 1 %While K > 0
 -> ECONT

STD PRED (25):! file errors      b25
 FILE ERRORS = 0
 -> ECONT

STD PRED (26):! nofileerrors     b26
 FILE ERRORS = 1
 -> ECONT

STD PRED (27):! rename(F,F1)     b27
{I77}   -> NIY
!EMAS!  ATOM TO FILE(INTEGER(X+V1OFCF))
!EMAS!  ERROR MES=File String
!EMAS!  %IF INTEGER(X+V2OFCF)=ATOMNIL %START
!EMAS!    Destroy (File String)
!EMAS!  %FINISH %ELSE %START
!EMAS!    ATOM TO FILE(INTEGER(X+V2OFCF))
!EMAS!    RENAME(ERROR MES.",".File String)
!EMAS!  %FINISH
!EMAS!CHECK FILES: 
!EMAS! %IF RETURN CODE#0 %START
!EMAS!   ERROR MES=SSFMESSAGE
!EMAS!   ->IO FAILURE
!EMAS! %FINISH
!EMAS! -> ECONT

!EMAS!STD PRED (29):  ! emas(_) b29
!VAX! STD PRED (29):  ! ie$editor (_)  b29
{APM} STD Pred (29):  ! ie$editor(_)   b29
         ERROR MES = ""
         -> Second Parameter

!VAX! STD PRED (30):  ! ie$editor (_,_) b30
!EMAS!STD PRED (30):  ! emas(_,_) b30
{APM} STD PRED (30):  ! ie$editor(_,_) b30
         ATOM TO FILE (INTEGER (X + V2 OF CF))
         ERROR MES = File String
      Second Parameter:
         ATOM TO FILE (INTEGER (X + V1 OF CF))

!EMAS!  {An effort at catching recursive calls (NOT foolproof!)}
!EMAS!  %IF File String="PROLOG" %OR %c
!EMAS!      File String="UTIL" %START
!EMAS!     PRINT STRING("! Prolog cannot be called recursively")
!EMAS!     NEWLINE
!EMAS!     -> ECONT
!EMAS!  %FINISH
!EMAS!  CALL(File String,ERROR MES)
!EMAS!  ->CHECK FILES

!VAX! %integer Start Line, Start Pos
!VAX! %string (127) Profile

!VAX! Error Mes = File String %if Error Mes = ""
!VAX! Set Up Terminal
!VAX! Profile = Translate ("IE_PROFILE")
!VAX! Profile = "" %if Profile = "IE_PROFILE"
!VAX! Start Line = 1                            {for the moment}
!VAX! Start Pos  = 1
!VAX! IE Default File Name = Current Default
!VAX! %begin
!VAX!    %on 15 {IE Abort} %start
!VAX!       Print String ("! IE Fails: " . Event_Message);  New Line
!VAX!       -> Out
!VAX!    %finish
!VAX!    
!VAX!    IE Editor (File String, Error Mes,
!VAX!               0, 23,
!VAX!               Start Line, Start Pos,
!VAX!               Profile,
!VAX!               Confirm!Reset Heap)
!VAX! out:
!VAX! %end
!VAX! Reset Terminal
!VAX! -> E Cont

{APM} Error Mes = File String %if Error Mes = ""
{APM} %if Set Up = 0 %start
{APM}    Terminal Model = Default Terminal
{APM}    Set Terminal Characteristics
{APM}    Set Up = 1
{APM} %finish
{APM} Set Up Terminal
{APM} Junk = Edit (File String, "", Error Mes, 1, 1)
{APM} Reset Terminal
{APM} Select Input (Input)
{APM} -> Econt

STD PRED (31):  ! prompt(_,_) b31
  ->EFAIL %IF UNIFYARG(X+V1OFCF,ATPROMPT,0)=0
  ->EFAIL %UNLESS ATOM0<=INTEGER(X+V2OFCF)<SKEL0
  ATPROMPT=INTEGER(X+V2OFCF)
  SET PLPROMPT (STRING (AT PROMPT + ST OF AE))
  ->ECONT

STD PRED (32): ! exists(F)  b32
  ATOM TO FILE(INTEGER(X+V1OFCF))
!EMAS!  ->ECONT %if Exist(File String) # 0
{I77}   ->ECONT %if Exists (File String)
{APM} Select Input (Input)
  ->EFAIL

STD PRED (33): ! save(F) a33
 Print String("[Closing all files]")
 New Line

 CLOSE FILES

 -> Econt %IF SAVE # 0
!EMAS!  -> Check File
{I77}   -> IO Failure

!-----------------------------------------------------------------------

!        arithmetic predicates


STD PRED (40):! is         b40
 K= INT0+INTVAL(X+V2OFCF)&(\INT0)
 ->UNIFYATOM

STD PRED (41):! X=:=Y        b41
 ->EFAIL %IF INTVAL(X+V2OFCF)#INTVAL(X+V1OFCF)
 ->ECONT

STD PRED (42):! X=\Y         b42
 ->EFAIL %IF INTVAL(X+V2OFCF)=INTVAL(X+V1OFCF)
 ->ECONT

STD PRED (43):! X<Y          b43
 ->EFAIL %IF INTVAL(X+V2OFCF)<=INTVAL(X+V1OFCF)
->ECONT

STD PRED (44):! X>Y          b44
 ->EFAIL %IF INTVAL(X+V1OFCF)<=INTVAL(X+V2OFCF)
 ->ECONT

STD PRED (45):! X=<Y       b45
 ->EFAIL %IF INTVAL(X+V1OFCF)>INTVAL(X+V2OFCF)
 ->ECONT

STD PRED (46):! X>=Y
 ->EFAIL %IF INTVAL(X+V1OFCF)<INTVAL(X+V2OFCF)
 ->ECONT

!-----------------------------------------------------------------------


STD PRED (50): ! VAR(X)   B50
 K=INTEGER(X+V1OFCF); ->ECONT %IF K>=GLB0 %AND INTEGER(K)=0
   ->EFAIL

STD PRED (51): ! NONVAR(X)   B51
 K=INTEGER(X+V1OFCF); ->ECONT %UNLESS K>=GLB0 %AND INTEGER(K)=0
  ->EFAIL

STD PRED (52): ! INTEGER(X)   B52
 ->ECONT %IF INTEGER(X+V1OFCF)&INT0=INT0
  ->EFAIL

STD PRED (53): ! ATOMIC(X)   B53
 ->ECONT %IF INTEGER(X+V1OFCF)<SKEL0
  ->EFAIL

STD PRED (59): ! atom(X) b59
 ->ECONT %IF 0<INTEGER(X+V1OFCF)<SKEL0
    -> EFAIL

STD PRED (54): ! == B54  (Currently in Prolog)
  ->ECONT

STD PRED (55): ! \==  B55  (Currently in Prolog)
 ->ECONT


STD PRED (56): ! functor(T,F,N)  b56
K=INTEGER(X+V1OFCF)
K1=INT0 %AND ->UNIFYFN %IF K<SKEL0
%IF K>=GLB0 %AND INTEGER(K)#0 %START
  K = INTEGER(INTEGER(K))
  K1 = INT0!BYTE INTEGER (K + ARITY OF FE)
  K = INTEGER(K)
  ->UNIFY FN
%FINISH
Y=INTVAL(X+V3OFCF)
K=INTEGER(X+V2OFCF) %AND ->UNIFYT %IF Y=0
  ->EFAIL %UNLESS 0<Y<100; K1=V1
L=Y
Check V1 (L*4)
%cycle
   INTEGER(V1)=0
   V1 = V1 + 4 
   L = L - 1 
%repeat %UNTIL L=0
K=INTEGER(X+V2OFCF);  ->EFAIL %UNLESS 0<K<SKEL0
K=FENTRY(K,Y)+GTOFFE
UNIFYT: ->ECONT %IF UNIFYARG(X+V1OFCF,K,K1)#0
  ->EFAIL
UNIFYFN: ->EFAIL %IF UNIFYARG(X+V2OFCF,K,0)=0
  ->ECONT %IF UNIFYARG(X+V3OFCF,K1,0)#0
  ->EFAIL

STD PRED (57): ! arg(N,T,A) b57
K=INTVAL(X+V1OFCF)
K1=INTEGER(X+V2OFCF)
->EFAIL %IF K1<GLB0 %OR INTEGER(K1)=0
Y=INTEGER(K1+4); K1=INTEGER(K1)
->EFAIL %UNLESS 0<K<=BYTEINTEGER(INTEGER(K1)+ARITYOFFE)
->ECONT %IF UNIFYARG(X+V3OFCF,ARGV(K1+K<<2,Y,Y),Y)#0
->EFAIL

STD PRED (58): !  X=..L   b58
K=INTEGER(X+V1OFCF)
->TCONS %IF K>=GLB0 %AND INTEGER(K)=0
K1=V+8
N=2
INTEGER(K1)=K %AND ->MKLST %IF K<GLB0
Y=INTEGER(K+4); K=INTEGER(K)
INTEGER(K1)=INTEGER(INTEGER(K))
%for L=1, 1, BYTE INTEGER (INTEGER (K) + ARITY OF FE) %cycle
  K1=K1+4
  N=N+1
  K=K+4
  B=ARG(K,Y)
  %IF SKEL0 <= B < GLB0 %START
    Check V1 (8)
    INTEGER (V1    ) = B
    INTEGER (V1 + 4) = Y
    B = V1
    V1 = V1 + 8
  %FINISH
  INTEGER(K1)=B
%REPEAT

MKLST: 
 INTEGER (K1 + 4) = ATOM NIL
 K = MAKE LIST(N,V+8); 
 V1 = V1 - 8
 ->ECONT %IF UNIFYARG(X+V2OFCF,INTEGER(K),INTEGER(K+4))#0
 ->EFAIL

TCONS:
K = INTEGER (X + V2 OF CF)
->EFAIL %IF K < GLB0 %OR INTEGER (K) = 0
Y=INTEGER(K+4); K=INTEGER(K)
L=V+8; N=0
%CYCLE
  ->EFAIL %UNLESS SKEL0<=K<GLB0 %AND INTEGER(K)=LISTFUNC
  N=N+1; K1=ARG(K+4,Y)
  %IF SKEL0<=K1<GLB0 %START
    Check V1 (8)
    INTEGER(V1)=K1
    INTEGER(V1+4)=Y
    K1=V1
    V1=V1+8
  %FINISH
  INTEGER(L)=K1
  L=L+4
  K = ARGV (K + 8, Y, Y)
%REPEAT %UNTIL K=ATOMNIL 
K=INTEGER(V+8); ->EFAIL %UNLESS K<SKEL0
%IF N=1 %START
  ->ECONT %UNLESS UNIFYARG(X+V1OFCF,K,0)=0
  ->EFAIL
%FINISH
->EFAIL %UNLESS K>0
K=APPLY(K,N-1,V+12); V1=V1-8
->ECONT %UNLESS UNIFYARG(X+V1OFCF,INTEGER(K),INTEGER(K+4))=0
->EFAIL

STD PRED (61): ! assert(C)
->DBFAIL %IF RECORD(DEFSOFFE,INTEGER(X+V1OFCF),0,0)=0
->ECONT

STD PRED (62): ! asserta(C)
->DBFAIL %IF RECORD(DEFSOFFE,INTEGER(X+V1OFCF),0,1)=0
->ECONT

STD PRED (63): ! assert(C,R)
K=0
ASSERTR: K=RECORD(DEFSOFFE,INTEGER(X+V1OFCF),0,K)
  Y=X+V2OFCF
UNFREF: ->DBFAIL %IF K=0

{Hazard?}
K1 = SKEL0+K&16_FFFFFF
{?drazaH}

BYTE INTEGER (K1 + INF OF CL) = IN USE FLAG
INTEGER(TR)=K1
TR = TR + 4
->EFAIL %IF UNIFY ARG (Y, K, 0) = 0
->ECONT

STD PRED (64): ! asserta(C,R)
 K=1
 ->ASSERTR

STD PRED (73): ! recorda(K,T,R)
 K=1; ->RECORDR

STD PRED (74):! recordz(K,T,R)
 K=0
RECORDR:
K=RECORD(DBOFFE,INTEGER(X+V2OFCF),INTEGER(X+V1OFCF),K)
Y=X+V3OFCF
->UNFREF

STD PRED (65): ! $clause(P,R,_)
   FL = INTEGER (FL) + ALT OF CL
   INTEGER (FL) = FL - ALT OF CL
   K = INTEGER (X + V3 OF CF)
   K = INTEGER (K) %IF K >= GLB0
   INTEGER (X + V4 OF CF) = INTEGER (K) + DEFS OF FE
STD PRED (66):
   K = RECORDED (DEFS OF FE)
   -> CUTFAIL %IF K=0
   K = INSTANCE (K, X + V1 OF CF)
   -> CUTFAIL %IF K <= 0
   -> ECONT

STD PRED (67): ! $recorded(T,R,K)
   K = INTEGER (X + V3 OF CF)
   K = INTEGER (K) %IF K >= GLB0
   INTEGER (X + V4 OF CF) = INTEGER (K) + DB OF FE
   FL = INTEGER (FL) + ALT OF CL
   INTEGER (FL) = FL - ALT OF CL
STD PRED (68):
   K = RECORDED (DB OF FE)
   -> CUTFAIL %IF K = 0
   -> ECONT

CUTFAIL: VV=INTEGER(X) %IF VV>=X
 ->EFAIL

DBFAIL:
 New Line
 Print String(ERRORMES)
 New Line
 DEBUG=1; SKLEV=1000000; ->CUTFAIL

STD PRED (69): ! instance(R,T)
   K = INSTANCE (INTEGER (X + V1 OF CF), X + V2 OF CF)
   -> ECONT %IF K = 1
   -> EFAIL %IF K = 0
   ERROR MES = "! first argument of instance must be a reference"
   -> DBFAIL

STD PRED (60): ! erase(R)
   -> ECONT %IF ERASE (INTEGER( X + V1 OF CF)) # 0
   -> DBFAIL

STD PRED (70): ! 'NOLC'
 LC=0
 ->ECONT

STD PRED (71): ! 'LC'
 LC=1
 ->ECONT

STD PRED (72): ! trace
 DEBUG = 1
 SKLEV = 1000000
 ->ECONT

STD PRED (76): ! op(P,T,A)
 K = OP (INTEGER (X + V1 OF CF), INTEGER (X + V2 OF CF), X + V3 OF CF)
 -> FAIL %IF K = 0
 -> CONTINUATION

STD PRED (78): ! $leash(P, N)
  -> EFAIL %IF UNIFY ARG (X + V1 OF CF, INT0 ! LEASH, 0) = 0
  LEASH = INT VAL (X + V2 OF CF)
  ->ECONT

STD PRED (79):  !  $debug(P,N)
  ->EFAIL %IF UNIFYARG(X+V1OFCF,DEBUG!INT0,0)=0
  DEBUG=INTVAL(X+V2OFCF)
  ->ECONT

STD PRED (75):   !  name(X,L)
 K=INTEGER(X+V1OFCF)
 ->NAMECONS %IF K>=GLB0  %AND INTEGER(K)=0
 ->NAMEERR  %IF K>=SKEL0
 %IF K>=ATOM0 %start 
   File String=STRING (K + ST OF AE)
 %ELSE
   ->NAMEERR %IF K&INT0#INT0
   K=K&16_1FFFFFFF %IF K&16_20000000=0
   File String=I To S(K, 0)
 %FINISH
 K1=V+8; N=LENGTH(File String)
 %for L=1,1,N %cycle
   INTEGER(K1)=INT0 ! CHARNO (File String, L)
   K1=K1+4
 %REPEAT
 N=N+1
 K1=K1-4
 ->MKLST

NAMECONS: K=INTEGER(X+V2OFCF)
 ->NAMEERR %IF K<GLB0 %OR INTEGER(K)=0
 Y=INTEGER(K+4); K=INTEGER(K)
 N=0
 %CYCLE
   ->NAMEERR %UNLESS SKEL0<=K<GLB0 %AND INTEGER(K)=LISTFUNC
   N=N+1; K1=ARG(K+4,Y); K=ARGV(K+8,Y,Y)
   ->NAMEERR %UNLESS K1&INT0=INT0
   K1=K1&16_1FFFFFFF %IF K&16_20000000=0
   ->NAMEERR %UNLESS 0<=K1<=255
   CHARNO(File String,N)=K1
 %REPEAT %UNTIL K=ATOMNIL 
 LENGTH(File String)=N
 %IF CHARNO(File String,1)='-' %THEN L=1 %ELSE L=0
 ->MKNAME %IF L=N; K1=0
 %CYCLE
   L=L+1; P=CHARNO(File String,L)
   ->MKNAME %UNLESS '0'<=P<='9'
   K1=K1*10+P-'0'
 %REPEAT %UNTIL L=N 
 K1=-K1 %IF CHARNO(File String,1)='-'
 ->ECONT %IF UNIFYARG(X+V1OFCF,INT0!K1,0)#0
 ->EFAIL
MKNAME: ->ECONT %IF UNIFYARG(X+V1OFCF,LOOKUP(File String),0)#0
 ->EFAIL

NAMEERR: ERRORMES="! ** Illegal arguments name(Atomic,List)"
 ->DBFAIL

STD PRED (80):  ! current_atom(A)
  K = INTEGER (X + V1 OF CF)
  -> CUT %IF 0 < K < SKEL0
  -> CUT FAIL %UNLESS K >= GLB0 %AND INTEGER (K) = 0
  INTEGER (X + V2 OF CF) = -4
  INTEGER (X + V3 OF CF) = 0
  FL = INTEGER (FL)
  INTEGER (FL + ALT OF CL)=FL
STD PRED (81):
  V = V + 12
  K = INTEGER (X + V2 OF CF)
  K1 = INTEGER (X + V3 OF CF)
  %WHILE K1 = 0 %CYCLE
    -> CUT FAIL %IF K >= 512
    K = K + 4
    K1 = INTEGER (HASHA + K)
  %REPEAT
  INTEGER (X + V2 OF CF) = K
  INTEGER (X + V3 OF CF) = INTEGER (K1 + NXT OF AE)
  K = UNIFY ARG (X + V1 OF CF, K1, 0)
  ->  ECONT

STD PRED (82): !  $current_functor(A,N,Key,Mask)    mode_(+,?,+,+)
  INTEGER(X+V5OFCF)=INTEGER(X+V1OFCF)
  FL=INTEGER(FL); INTEGER(FL+ALTOFCL)=FL
STD PRED (83):
  V=V+20; K1=INTEGER(X+V5OFCF)
NEXTFUNC:  ->CUTFAIL %IF K1=0
  K=K1; K1=INTEGER(K+NXTOFFE)
  L=INTEGER(X+V3OFCF)&255
  ->NEXTFUNC %IF INTEGER(X+V4OFCF)&BYTEINTEGER(K+FLGSOFFE)#L     
  ->NEXTFUNC %IF INTEGER(X+V3OFCF)&256#0 %AND INTEGER(K+DEFSOFFE)=0
  ->NEXTFUNC %IF UNIFYARG(X+V2OFCF,INT0!BYTEINTEGER(K+ARITYOFFE),0)=0
  INTEGER(X+V5OFCF)=K1
  ->ECONT

STD PRED (84):   !  $flags(P,Old,New)
  K = INTEGER (INTEGER (INTEGER(X + V1OFCF))) + FLGS OF FE
  ->EFAIL %IF UNIFY ARG (X + V2 OF CF, INT0!BYTE INTEGER (K), 0) = 0
  BYTE INTEGER (K) = INT VAL (X + V3 OF CF)&255
  ->ECONT


!-----------------------------------------------------------------------

!    System private predicates

STD PRED (100): !  $sysp(F,N)
   INTEGER (INTEGER (INTEGER (INTEGER (X + V1 OF CF))) + DEFS OF FE)= %c
      INTEGER (X + V2 OF CF)&255
   ->CONTINUATION

STD PRED (101): !  $sysflgs(P,N)
   BYTE INTEGER (INTEGER (INTEGER (INTEGER (X + V1 OF CF))) + FLGS OF FE)= %c
      INTEGER (X + V2 OF CF)&255
   -> CONTINUATION

STD PRED (102): ! $break(G) a102
   BG = ARG (G + 4, X1)
   ->EFAIL %IF BG < 0 %or %c
               INTEGER (BG) = 0
   %IF GLB0 > BG >= SKEL0 %START
      Check V1 (8)
      INTEGER (V1) = BG
      INTEGER (V1 + 4) = X1
      BG = V1
      V1 = V1 + 8
   %FINISH
   BRTN = 1

L BREAK: 
   SAVE VARS
   PG = BG
   -> ICALL

STD PRED (103): ! $exit_break a103
   RESTORE VARS
   -> RTN AFT BREAK(BRTN)
RTN AFT BREAK (1): 
   ->CONTINUATION
RTN AFT BREAK (2): 
   ->MESSAGE

STD PRED (104): ! $prompt(P) b104
 PROMPT (STRING (INTEGER(X + V1 OF CF) + ST OF AE))
 ->ECONT

STD PRED (105): ! $user_exec(_) b105
  C = INTEGER (X + V1 OF CF)
  V = V + 4
  LEV = 1
  INVOK NO = 0
  SK LEV = 0
  EXEC SYS = 0
  -> CONTINUATION

STD PRED (106): ! $save_read_vars a106
 V CHAIN = VAR CHAIN
 PVRZ = VRZ
 VRZ = VAR FP
 ->CONTINUATION

STD PRED (107): ! $reset_read_vars a107
  VRZ=PVRZ
  ->CONTINUATION

STD PRED (108): ! $repply a108
 ->CONTINUATION %IF VCHAIN=0
 K=ADDR(VCHAIN); ! TTYFLG=-1
 %CYCLE
   K = INTEGER(K)
   Print String (STRING (K + 8))
   Print String(" = ")
   PWRITE (VVALUE(INTEGER(K+4),K1),K1,1200)
   New Line
 %REPEAT %UNTIL INTEGER(K)=0 
 PROMPT("redo ? ");
 GETC(CH)
 CH2=CH
 GETC(CH2) %WHILE CH2 # NL
 PROMPT(PLPROMPT); ! TTYFLG=0
 ->EFAIL %IF CH=';' %OR CH='Y' %OR CH='y'
 ->CONTINUATION

STD PRED (109): ! $recons(_) b109
 RECONS=INTEGER(X+V1OFCF)&255
 ->ECONT

STD PRED (110): ! $break_start a110
 BRKLEV=BRKLEV+1
 Print String("[Break (level ")
 B WRITE(BRKLEV,0)
 Print String(")]")
 New Line
 ->CONTINUATION

STD PRED (111): ! $break_end a111
 Print String ("[End Break (level ")
 B WRITE (BRKLEV,0)
 Print String (")]")
 New Line
 BRKLEV=BRKLEV-1
 ->CONTINUATION

STD PRED (112): ! $assertr(_) b112
  K=RECORD(DEFSOFFE,INTEGER(X+V1OFCF),RECONS,0)
  ->ECONT %IF K#0
  New Line
  Print String(ERROR MES)
  New Line
  ->EFAIL


STD PRED (113): ! $rest_in_peace  a113
  CLOSE FILES
!EMAS!RELEASE STACKS
  NEWLINES(2); PRINTSTRING("[Prolog execution halted]"); NEWLINE
  %RETURN

STD PRED (114):            ! b114  $patch(N)
         -> NIY

{*         PATCH(INTEGER(X+V1OFCF))
{*         -> ECONT

STD PRED (115):            ! B115  $repeat
         -> STD PRED  (3)

STD PRED (116):            ! a116  $read(X)
         {???}
         -> STD Pred (17)

!VAX! STD PRED (117):      ! set_default(X)
!VAX!    Atom To File (Integer (X + V1 Of CF))
!VAX!    Set Default (File String)
!VAX!    -> E Cont

{APM} Std Pred (117):            ! set_terminal_mode
{APM}    K = Integer (X + V1 Of Cf)
{APM}    %if K >= 0 %start
{APM}       Print String ("! Invalid parameter to set_terminal_mode - need integer")
{APM}       New Line
{APM}       -> E Fail
{APM}    %finish
{APM}    Set Terminal Mode (K&(\Int 0))
{APM}    -> E Cont

!VAX! %string (127) Temp

!VAX! Std Pred (118):      ! current_default (X)
!VAX!    Temp = Current Default
!VAX!    K = Look Up (Temp)
!VAX!    -> Unify Atom

{APM} Std Pred (118):      ! test_symbol(X)
{APM}    K = Test Symbol
{APM}    -> E Fail %if K < 0
{APM}    -> E Fail %if Unify Arg (X + V1 Of CF, K!Int0, 0) = 0
{APM}    -> E Cont

Std Pred (119):            !  call_edwin
   -> E Fail %if Call Edwin = 0
   -> E Cont

%END {Prolog Interpreter}

%end %of %file