*   
*        PROCEDURE CALL REQUIRES THE FOLLOWING OPERATIONS
*        IN THE ORDER SPECIFIED
*   
*        1 ) P_SP           <-- P_SP - (PARM_AREA_SIZE)
*        2 ) MP             <-- P_SP
*        3 ) STACK[MP+2]    <-- P_PC
*        4 ) STACK[MP+4]    <-- BASE
*        5 ) P_PC           <-- (ENTRY_POINT_ADDRESS)
*        6 ) BASE           <-- P_PC
*        7 ) STOR[MP+6]     <-- DISPLAY[N_LVL]
*        8 ) DISPLAY[N_LVL] <-- MP
*        9 ) P_PC           <-- P_PC+10
*   
*   
*        THE LINK AREA CONSISTS OF THE FOLLOWING FIELDS:
*   
*              LNKAREA   : OLD_MP,
*              LNKAREA+2 : RETURN ADDRESS,
*              LNKAREA+4 : OLD_BASE,
*              LNKAREA+6 : OLD_DISP[N_LVL]
*   
*   
*        AND AFTER PROCEDURE ENTRY WE HAVE (NEW) MP == LNKAREA+8
*   
*   
*   
*        WHERE  P_PC  ::=   P_MACHINE PROGRAM COUNTER
*               P_SP  ::=   P_MACHINE STACK POINTER
*               N_LVL ::=   STATIC LEVEL OF THE CALLED (NEW)
*        PROCEDURE
*               MP    ::=   MARK POINTER
*               BASE  ::=   'CURRENT' PROC BASE ADDRESS
*               O_LVL ::=   STATIC LEVEL OF THE CALLING ROUTINE
*   
*   
*   
*        ZCUP, CALL USER PROCEDURE; LONG FORMAT
*              PROCTBL IS ALLIGNED ON PAGE BOUNDARY
*   
ZCUP  INX  B
  LDAX  B  PICK THE PROC #
  JMP  ZENT
*   
*        ZCUP1, CALL USER PROCEDURE; SHORT FORM.
*   
ZCUP1  LDAX  B
  ANI  00FH  GET THE PROC #
*   
ZENT  POP  H
  SHLD  MP  SET NEW_MP
  XCHG  ,  DE <-- NEW_MP
  LHLD  BASE
  PUSH  B  SET RETURN ADDR.
  PUSH  H  SET OLD BASE ADDR. FIELD
*   
  ADD  A  COMPUTE PROC. ENTRY ADDRESS.
*        LD    L,A
*        LD    H,PROCTBL,<
  LHLD  PROCTBL
  MVI  B,0
  MOV  C,A
  DAD  B
  MOV  A,M
  INX  H
  MOV  H,M
  MOV  L,A  HL <-- PROC ENTRY POINT ADDR.
*   
*   
*        FORMAT OF THE ENTRY POINT OF PROCEDURES:
*   
*         ------------------------------------------------------
*        \ LEVEL  \-PRM_SZE \DATA_AREA_SIZE  \   PROC. ID.
*        ...
*         ------------------------------------------------------
*   
  SHLD  BASE  UPDATE PROGRAM BASE
  MOV  A,M  A <-- LEVEL OF CALLED PROC.
  LXI  H,DISP
  ADD  L
  MOV  L,A
  MOV  C,M
  MOV  M,E  UPDATE DISP[OLD_LVL] WHILE COPYING
  INX  H
  MOV  B,M  BC <-- CURRENT DISP[OLD_LVL]
  MOV  M,D
  PUSH  B  SAVE OLD DISP.
*   
  LHLD  BASE
  INX  H
  INX  H
  MOV  A,M  PICK THE SIZE OF DATA AREA
  ADD  D
  MOV  D,A
  INX  H
  MOV  A,M
  ADD  E  ADD IT TO CURRENT P_SP
  MOV  E,A
  JNC  E06
  INR  D  TO OBTAIN NEW P_SP
E06  LXI  B,ENTAREA-3
  DAD  B
  MOV  B,H  POINT TO BEGINNING OF PROCEDURE BODY
  MOV  C,L
  JMP  FET1
*   
*   
*   
*        THE PROCEDURE RETURN SEQUENCE SHOULD INCLUDE THE
*        FOLLOWING
*        ACTIONS IN THE SPECIFIED ORDER
*   
*   
*        1) P_SP           <-- MP ;             (RESET P_STACK
*        PTR)
*        2) P_PC           <-- STACK[P_SP+2] ;  (SET RETURN
*        ADDRESS)
*        3) DISPLAY[N_LVL] <-- STACK[MP+6] ;    (OLD DISPLAY
*        VALUE)
*        4) IF N_TYP <> 'PROC' THEN  P_SP <-- P_SP+2 ;
*                                    (ADJUST P_SP FOR FUNC.
*        RETURNS)
*        5) BASE           <-- STACK[MP+4] ;    (RESTORE OLD
*        BASE)
*        6) MP             <-- DISPLAY[O_LVL] ; (RESTORE MP
*        )
*        7) GOTO 'FETCH' ;
*   
*   
*   
*   
*   
*   
*        ZRET, RETURN FROM USER PROCEDURE.
*   
ZRET  POP  B  PICK UP ORIGINAL DISP. VALUE
  LHLD  BASE
  MOV  A,M
  ADI  >DISP
  MVI  H,<DISP
  MOV  L,A  POINT TO THE RIGHT DISPLAY FIELD
  MOV  M,C
  INX  H
  MOV  M,B
  POP  H  GET THE BASE OF OLD PROC
  SHLD  BASE  UPDATE CURR. BASE
  POP  B  GET PROC. RETURN ADR
  LHLD  MP
  POP  D  DE <-- OLD_MP
  XCHG  ,  AND RESET P_SP
  SHLD  MP
  JMP  FETCH
*   
*   
*        ZRETF, RETURN FROM USER FUNCTION.
*   
ZRET8  MVI  E,8  SIZE OF THE VALUE TO BE RETURNED
  JMP  RT02
*   
ZRETF  MVI  E,2
*   
RT02  POP  B  PICK UP ORIGINAL DISP. VALUE
  LHLD  BASE
  MOV  A,M
  ADI  >DISP
  MVI  H,<DISP
  MOV  L,A  POINT TO THE RIGHT DISPLAY FIELD
  MOV  M,C
  INX  H
  MOV  M,B
  POP  H  GET THE BASE OF OLD PROC
  SHLD  BASE  UPDATE CURR. BASE
  POP  B  GET PROC. RETURN ADR
  MVI  D,0  DE <-- SIZE OF FUNCTION RESULT
  LHLD  MP
  DAD  D
  POP  D  DE <-- OLD_MP
  XCHG  ,  AND RESET P_SP
  SHLD  MP
  JMP  FETCH
*   
********************************************
*   
*  HEAP MANIPULATION OPERATIONS
*   
********************************************
*   
*** ZNEW & ZRST ***
*   
ZNEW  XCHG  ,
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M
  PUSH  H  SAVE FUTURE P_SP
  LHLD  NP  HL <-- CURRENT HEAP PTR
  INX  B
  LDAX  B  BYTE COUNT
  CMA  ,
  INR  A
  JZ  NW02  ONLY SAVE HEAP PTR (PSAV)
  ADD  L
  MOV  L,A
  JC  NW02  NO NEED TO ADJUST HIGH BYTE
  DCR  H
NW02  SHLD  NP
  XCHG  ,  DE <-- PTR,  HL <-- TARGET ADR
  MOV  M,D
  INX  H
  MOV  M,E
  POP  D
  JMP  FETCH
*   
ZRST  DCX  D
  LDAX  D
  MOV  L,A
  DCX  D
  LDAX  D
  MOV  H,A
  SHLD  NP
  JMP  FETCH
*   
*   
*******************************************
*   
*  PROVISIONAL I/O INTERFACE ROUTINES
*   
*******************************************
*   
*   
*   GETCHAR, GETS THE NEXT INPUT CHAR, TRANSLATES IT TO BIASSED
*        ASCII,
*            TRANSLATES ALL CONTROL CHARS TO 'SPACE', CONVERTS
*        LOWER
*            CASE UPPER CASE, AND SETS 'EOF', 'EOLN' FLAGS.
*   
*   
GETCHAR  CALL  INPCH  GET NEXT INPUT CHAR
*GETCHAR  PUSH  HL            (SP) <-- FILE ADR
*        CALL  DECHL8  HL,-FLGAREA
*        LD    A,(HL)
*        AND   ENDFILE-ENDLINE
*        JP    NZ,GCH04
*        CALL  INPCH         GET CHAR FROM INPUT DEVICE (HL)
  MVI  M,0  CLEAR FLAGS
  CPI  CR  END OF LINE ?
  JNZ  GCH02
  MVI  M,ENDLINE  SET EOLN FLAG
  MVI  A,SPACE
GCH02  CPI  ASCEOF  END OF FILE ?
  JNZ  GCH04
  MVI  M,ENDFILE  SET EOF FLAG
  MVI  A,SPACE
**GCH04  CPI  SPACE  CONVERT CONTROL CHARS TO SPACE
* JP  GCH06
* MVI  A,SPACE
GCH06  SUI  BIASS  CONVERT TO BIASSED ASCII
GCH04 EQU GCH06
* CPI  64  CONVERT LOWER CASE TO UPPER
* RM
* SUI  32  CONVERT LOWER CASE TO UPPER
  RET  ,
*   
*   
*   PUTCHR, CONVERTS THE CHAR IN THE 'A' REG TO ASCII AND
*        SENDS IT TO
*           THE OUTPUT DEVICE INDICATED BY 'HL'.
*   
*   
*PUTCHAR  PUSH  HL
*        CALL  DECHL8  HL,-FLGAREA
PUTCHAR  ADI  BIASS
  CALL  OUTCH
*        POP   HL
  RET  ,
*   
*   
DECHL8  DCX  H  SUBTRACTS 'FLGAREA' FROM 'HL'
  DCX  H
  DCX  H
  DCX  H
  DCX  H
  DCX  H
  DCX  H
  DCX  H
  RET  ,
*   
INCHL8  INX  H  ADDS 'FLGAREA' TO 'HL'
  INX  H
  INX  H
  INX  H
  INX  H
  INX  H
  INX  H
  INX  H
  RET  ,
*   
********************************************
*   
*  CALL TO STANDARD PROCEDURES
*   
********************************************
*   
*   
*** ZRST ***
*   
*  ZSPRST, TO RESET A FILE FOR INPUT
*   
ZSPRES  MVI  A,READOPN
RS02  XCHG  ,
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M  DE <-- FILE ADR.
  INX  H
  INX  H
  XCHG  ,  RESET P_SP
  INX  H
  CALL  DECHL8  HL,-FLGAREA
**MVI  M,0  RESET EOF, EOLN FLAGS
  CALL  OPNFIL
  CPI  WRITOPN
  JZ  FETCH  OUTPUT FILES NEED NO INITALIZATION
*   
  CALL  GETCHAR
  CALL  INCHL8
  MOV  M,A  INITIALIZE FILE BUFFER
  JMP  FETCH
*   
*** ZSPRW ***
*   
*  ZSPRW, TO REOPEN A FILE FOR OUTPUT
*   
ZSPRW  MVI  A,WRITOPN  SET OPEN FLAG
  JMP  RS02
*   
*** ZSPGET
*   
*  GET NEXT CHAR INTO FILE BUFFER
*   
ZSPGET  DCX  D
  LDAX  D
  MOV  L,A
  DCX  D
  LDAX  D
  MOV  H,A
  INX  D
  INX  D
  INX  H
  PUSH  H
  CALL  DECHL8  ,
  CALL  GETCHAR
  POP  H
  MOV  M,A
  JMP  FETCH
*   
*** ZSPPUT
*   
*  PUT FILE BUFFER CONTENTS, FILE ADDR. ON TOP OF STACK
*   
ZSPPUT  DCX  D
  LDAX  D
  MOV  L,A
  DCX  D
  LDAX  D
  MOV  H,A
  INX  H
  MOV  A,M
  CALL  DECHL8  ,
  CALL  PUTCHAR
  INX  D
  INX  D
  JMP  FETCH
*** ZSPRDC ***
*   
*  READ A CHARACTER
*   
ZSPRDC  PUSH  B  SAVE BC
  XCHG  ,
  DCX  H
  MOV  C,M
  DCX  H
  MOV  B,M  GET READ DESTINATION IN BC
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M
  INX  H
  INX  H
  INX  D
  XCHG  ,  AND FILE BUFFER ADR IN HL
  XRA  A
  STAX  B
  MOV  A,M
  INX  B
  STAX  B
  PUSH  H
  CALL  DECHL8  ,
  CALL  GETCHAR  WRITE OUT THE CHAR
  POP  H
  MOV  M,A
  POP  B
  JMP  FETCH
*   
*** ZSPRS ***
*   
*  ZSPRS, TO READ A STRING OF CHARS
*   
ZSPRS  PUSH  B  SAVE BC
  DCX  D
  LDAX  D  A <-- CHAR COUNT
  DCX  D
  XCHG  ,
  DCX  H
  MOV  C,M
  DCX  H
  MOV  B,M  BC <-- STRING ADDRESS
  PUSH  H  SAVE NEXT P_SP
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M
  XCHG  ,  HL <-- FILE BUFFER ADDRESS
  INX  H
  MOV  E,A  E <-- CHAR COUNT
  MOV  D,M  FIRST CHAR COMES FROM BUFFER
  PUSH  H
  CALL  DECHL8  ,
RDS4  XRA  A
  STAX  B  CLEAR HIGH PART
*        LD    A,(HL)
  INX  B
  MOV  A,D
  STAX  B
  INX  B
*        PUSH  HL
*        CALL  DECHL8  HL,-FLGAREA
*        LD    D,(HL)        SAVE CURRENT FLAG SETTINGS
*        POP   HL            RESTORE FIE ADR
*        CALL  GETCHAR
*        LD    (HL),A        SET CAHR IN PASCAL BUF.
*        LD    A,D           LOOK AT LAST FLAGS
  MOV  A,M  GET THE FILE FLAGS
  ANI  ENDLINE  END OF LINE ?
  JNZ  RDS5
  CALL  GETCHAR
  MOV  D,A
*        INC   BC
  DCR  E
  JNZ  RDS4
  POP  H  PREPARE TO LEAVE
  JMP  RDS8
*   
*        INC   E
*RDS5     XOR   A             A <-- SPACE
RDS5  CALL  GETCHAR
  POP  H
*        LD    A,D
  MOV  M,A
  DCR  E
  JZ  RDS8
  XRA  A
  STAX  B
  INX  B
  MVI  A,255  SET ENDOFLINE MARKER IN INPUT STRING
  STAX  B
*   
*RDS6     DEC   E
*        JP    Z,RDS8        QUIT IF COUNT EXHAUSTED
*        INC   BC
*        LD    (BC),A        FILL THE REST OF STRING WITH
*        BLANKS
*        INC   BC
*        LD    (BC),A        ASSUMES 'A' = 0 = SPACE-BIASS
*        JP    RDS6
*   
RDS8  POP  D
  POP  B
  JMP  FETCH
*   
*** RDI ***
*   
*  ZSPRI, TO READ AN INTEGER
*   
ZSPRI  PUSH  B  SAVE BC
  XCHG  ,
  DCX  H
  MOV  C,M
  DCX  H
  MOV  B,M
  PUSH  H  SAVE FUTURE DE
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M
  XCHG  ,  HL <-- FILE BUFFER ADR.
  INX  H
  PUSH  B  SAVE ADRE. OF VAR. TO BE READ INTO
  MOV  A,M  START WITH THE CHAR IN THE BUFFER
  PUSH  H
  CALL  DECHL8  ,
RI01  CPI  SPACE-BIASS
*        CP    SPACE
  JNZ  RI03
RI02  CALL  GETCHAR
  JMP  RI01
*   
RI03  LXI  D,0  CLEAR THE ACCUMULATOR
  CPI  ASCMIN-BIASS
  MVI  B,-1
  JZ  RI04
  MVI  B,0  REMEMBER THE SIGN
  CPI  ASCPLU-BIASS
  JNZ  RI06
RI04  CALL  GETCHAR
RI06  SUI  ASCZER-BIASS
  JC  RI10  NON DIGIT, GET OUT
  CPI  ASCNIN-ASCZER+1
  JNC  RI10
*   
  PUSH  H  SAVE FILE ADR.
  XCHG  ,
  DAD  H
  MOV  D,H
  MOV  E,L
  DAD  H  TIMES 4
  DAD  H  TIMES 8
  DAD  D  TIMES 10
  MOV  E,A
  MVI  D,0
  DAD  D  ADD NEW DIGIT
  XCHG  ,
  POP  H  RESTORE FILE ADR.
  JMP  RI04
*   
RI10  ADI  ASCZER-SPACE  CONVERT TO BIASSED ASCII
  POP  H
  MOV  M,A
  MOV  A,B  CHECK THE SIGN
  ANA  A
  JZ  RI12
  MOV  A,D
  CMA  ,
  MOV  D,A
  MOV  A,E
  CMA  ,
  MOV  E,A
  INX  D  NEGATE THE RESULT
RI12  POP  H  GET BACK THE ADR. FOR THE RESULT
  MOV  M,D
  INX  H
  MOV  M,E
  POP  D  RESET NEW P_SP
  POP  B  RESTORE P_PC
  JMP  FETCH
*   
*** ZSPWRC ***
*   
*  ZSPWRC, WRITE A CHARACTER
*   
ZSPWRC  PUSH  B
  XCHG  ,
  DCX  H
  MOV  C,M  C <-- FLDWIDTH
  DCX  H
  DCX  H
  MOV  B,M  B <-- CHAR TO BE WRITTEN
  DCX  H
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M
  INX  H
  INX  H
  INX  D
  XCHG  ,  HL <-- FILE ADR.
**  PUSH  H
  CALL  DECHL8
WRC2  DCR  C
  JZ  WRC4
  MVI  A,SPACE-BIASS
  CALL  PUTCHAR  PRINT LEADING BLANKS
  JMP  WRC2
WRC4  MOV  A,B
  CALL  PUTCHAR
**  POP  H
**  MOV  M,A
  POP  B
  JMP  FETCH
*   
*** ZSPWP ***
*   
*  TO WRITE A STRING OF PACKED CHARS
*   
ZSPWP  XRA  A  SET 'PACKED' FLAG
  JMP  WRS0
*   
*** ZSPWS ***
*   
*  ZSPWS, TO WRITE A STRING OF ASCII CHARS
*   
ZSPWS  MVI  A,1  SET 'UNPACKED' FLAG
WRS0  STA  PFLG
  PUSH  B  SAVE BC
  XCHG  ,
  DCX  H
  MOV  C,M  C <-- LENGTH OF STRING
  DCX  H
  DCX  H
  MOV  B,M  B <-- NUMBER OF CHARS TO BE WRITTEN
  DCX  H
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M  DE <-- STRING ADDRESS
  PUSH  D  SAVE STRING ADDRESS
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M
  INX  H
  INX  H
  XTHL  ,  HL <-- STRING ADR, (SP) <-- NEXT P_SP
  INX  D
  XCHG  ,  HL <-- FILE BUF. ADR,  DE <-- STRING ADR
**PUSH  H
  CALL  DECHL8  ,
WRS2  MOV  A,C
  CMP  B
  JNC  WRS3  NO MORE LEADING BLANKS
  MVI  A,SPACE-BIASS
  CALL  PUTCHAR
  DCR  B
  JMP  WRS2
*   
WRS3  MOV  A,B
  ANA  A
  JZ  WRS8
WRS4  LDA  PFLG  TEST THE 'PACKED' FLAG
  ANA  A
  JZ  WRS6  SKIP THE NEXT IF PACKED.
  INX  D  POINT TO NEXT CHAR IN STRING
WRS6  LDAX  D
  CALL  PUTCHAR  OUTPUT NEXT CHAR
  INX  D
  DCR  B  DECREMENT COUNT
  JNZ  WRS4
**POP  H
**MOV  M,A
WRS8  POP  D
  POP  B
  JMP  FETCH
*   
*** WRI ***
*   
*  ZSPWI, TO WRITE AN INTEGER
*   
ZSPWI  PUSH  B  SAVE P_PC
  XCHG  ,
  DCX  H
  MOV  A,M  GET FIELD WIDTH
  STA  FLW
  DCX  H
  DCX  H
  MOV  C,M
  DCX  H
  MOV  B,M  BC <-- VALUE TO BE PRINTED
  PUSH  H  SAVE NEXT VALUE OF P_SP
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M  DE <-- FILE ADR
  INX  D
  XCHG  ,
**PUSH  H
  CALL  DECHL8  ,
  SHLD  SAVE1  SAVE FILE ADR.
  MOV  H,A  H <-- FLDWIDTH
  MOV  A,B
  ANA  A  SEE IF PRINTING A NEGATIVE VALUE
  MVI  L,SPACE-BIASS
  JP  WI04
  MVI  L,ASCMIN-BIASS
  CMA  ,
  MOV  B,A
  MOV  A,C
  CMA  ,
  MOV  C,A
  INX  B  CHANGE TO POSITIVE NUMBER
*   
WI04  LXI  D,10
  CALL  DIVIDE
  MOV  A,E  CONVERT THE REMAINDER TO
  ADI  ASCZER-BIASS  ASCII DIGIT
  PUSH  PSW  AND SAVE IT
  DCR  H  ADJUST DIGIT COUNT
**JZ  WI12  IF DONE, QUIT
  MOV  A,B
  ORA  C  SEE IF QUOTIENT ZERO
  JNZ  WI04
*   
  MOV  A,L  GET BACK THE SIGN
  ANA  A  I.E. COMPARE WITH SPACE-BIASS
  JZ  WI06
  PUSH  PSW  PUSH SIGN
  DCR  H
WI06  MOV  A,H
  MOV  C,H
  LHLD  SAVE1  RESTORE FILE ADDRESS
  ANA  A
  JM  WI08  IF EXCEEDED OR
  JZ  WI08  EXHAUSTED FIELD WIDTH, NO LEADING BLANKS.
  MOV  B,C
WI07  SUB  A  A <-- SPACE-BIASS
  CALL  PUTCHAR
  DCR  B
  JNZ  WI07
*   
WI08  LDA  FLW
  SUB  C
  MOV  C,A  C <-- # OF STACKED DIGITS
WI14  POP  PSW
  CALL  PUTCHAR
  DCR  C
  JNZ  WI14
**POP  H
**MOV  M,A  UPDATE PASCAL BUFFER
*   
  POP  D  RESTORE P_SP
  POP  B  AND P_PC
  JMP  FETCH
*   
*** ZSPWLN ***
*   
*  WLN, TERMINATE THE CURRENT LINE
*   
ZSPWLN  MOV  H,D
  MOV  L,E
  DCX  H
  MOV  A,M
  DCX  H
  MOV  H,M
  MOV  L,A
  INX  H  HL <-- FILE ADR.
  CALL  DECHL8  ,
  MVI  A,CR-BIASS
  CALL  PUTCHAR
*        LD    A,LF          THIS WILL NOT BE NEEDED IN THE
*        CALL  PUTCHAR       FINAL VERSION
  JMP  FETCH
*   
*** ZSPRLN ***
*   
*  RLN, SKIP THE REST OF THE CURRENT TO THE BEGINNING OF THE
*        NEXT LINE
*   
ZSPRLN  PUSH  D
  XCHG  ,
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M
  XCHG  ,
  INX  H  HL <-- FILE ADR
  PUSH  H  (SP) <-- FILE ADR
  CALL  DECHL8  HL,-FLGAREA
RL02  MOV  E,M
*        EX    (SP),HL       HL <-- FILE ADR, (SP) <-- FLAG
*        AREA
  CALL  GETCHAR
  MOV  D,A  SAVE CURRENT CHAR
*        LD    (HL),A
  MOV  A,E
  ANI  ENDLINE  END OF CURRENT LINE ?
*        EX    (SP),HL       HL <-- FLAG AREA
  JZ  RL02
  POP  H
  MOV  M,D  UPDATE PASCAL BUFF
  POP  D
  JMP  FETCH
*   
*** ZSPEOF ***
*   
*  END OF FILE, PREDICATE
*   
ZSPEOF  MVI  A,ENDFILE-ENDLINE
  JMP  EL01  JOIN ELN ROUTINE
*   
*** ZSPELN ***
*   
*  END OF INPUT (TEXT) LINE, PREDICATE
*   
ZSPELN  MVI  A,ENDLINE
EL01  PUSH  PSW
  DCX  D
  LDAX  D
  MOV  L,A
  DCX  D
  LDAX  D
  MOV  H,A
  XRA  A
  STAX  D  CLEAR HIGH ORDER BYTE OF RESULT
  INX  H
  CALL  DECHL8  HL,-FLGAREA
  POP  PSW
  ANA  M  IS THE FLAG SET ?
  MVI  A,TRUE  ASSUME IT IS END OF LINE
  JNZ  EL02
  XRA  A  NOT ELN, CHANGE TO FALSE
EL02  INX  D
  STAX  D
  INX  D
  INX  D
  INX  D
  JMP  FETCH
*   
*** ZSPEIO
*   
*  'EIO', END I/O GROUP, REMOVES THE FILE NAME FROM STACK.
*   
ZSPEIO  DCX  D
  DCX  D
  JMP  FETCH
*   
*** ZSPXIT ***
*   
*  EXIT USER PROGRAM WITH A RETURN CODE
*   
ZSPXIT  LHLD  DISP
  CALL  DECHL8  HL,-8
  MVI  C,4  NUMBER OF FILES TO BE CLOSED (IF OPEN)
XT02  CALL  CLSFIL
  INX  H
  INX  H
  DCR  C
  JNZ  XT02
  DCX  D
  LDAX  D  GET RETURN CODE
*   
*        RESET 'SP' TO ITS ORIGINAL VALUE
*   
XT04  LHLD  ISTK+2
  SPHL  ,
  JMP  STNDXIT
  RET  ,
*   
*        ERROR EXIT FOR THE INTERPRETER
*   
ERROR  MVI  A,255
  JMP  XT04
*