;*************************************************************;*         PASCAL STANDARD ASSEMBLER PACKAGE.                *;*                                                           *;* (C) 1980 DANSK DATA ELEKTRONIK APS.                       *;*************************************************************;;*************************************************************;* PROCEDURE NAME:      PURGEF                               *;*************************************************************;; CT 07-MAY-1980/22-SEP-1980;;=============================================================; DESCRIPTION:; THIS PROCEDURE PURGES A MIKADOS FILE.; PLEASE REFER TO THE PASCAL STANDARD ASSEMBLER PACKAGE MANUAL; SECTION 8.4 FOR DETAILS.;;-------------------------------------------------------------; STACK CONTENTS ON ENTRY:     I               I;                              I---------------I;                              I  RETURN ADR.  I;                              I---------------I;                              I  -> FILENAME  I;                              I---------------I;                              I               I;-------------------------------------------------------------; STACK CONTENTS ON EXIT:      EMPTY;=============================================================        SKIP       SYMB PURGEF:: ;;GET AND SAVE POINTER FROM STACK;       POP     D       ;DE=RETURN ADDRESS       POP     H       ;HL->FILENAME       SHLD    FILPTR  ;SAVE ADDRESS OF FILENAME       PUSH    D       ;PUT RETURN ADDRESS BACK ON STACK ;;CHECK THAT THERE IS ROOM ON THE HEAP FOR THE DCB;       LHLD    NP      ;HL->NEXT VACANT IN HEAP       XCHG            ;DE->NEXT VACANT IN HEAP       LXI     H,-#256-#48-#40-#10 ;HL:=REQUIRED DISTANCE                                   ; BETWEEN STACK AND HEAP       DAD     SP       MOV     A,L     ;CALCULATE DISTANCE       SUB     E       MOV     A,H       SBB     D       ;IS IT SUFFICIENT?       JNC     SUFF    ;YES       MVI     E,'K'   ;(SET UP ERROR CODE FOR UNSIFFICENT                       ;  STACK LENGTH)       JMP     XEQRR   ;NO. TERMINATE WITH RUN TIME ERROR K       SUFF:  XCHG            ;YES. HL->TOP OF HEAP       SHLD    DCBADR  ;THIS SHOULD BE THE DATA CONTROL BLOCK       LXI     D,#256+#48 ;RESERVE ROOM       DAD     D          ;   ON HEAP       SHLD    NP         ;      FOR DCB       ;;THE FOLLOWING CODE BUILDS AND PUSHES THE PARAMETERS FOR THE;PURGE SUBROUTINE;       LXI     D,1     ;DCB SIZE       PUSH    D ;;BLANK FILNAM;       MVI     A,#8     ;A=LENGTH OF FIELD TO BE BLANKED       LXI     H,FILNAM ;HL->FIELD TO BE BLANKED       CALL    E0LIN    ;BLANK IT! ;;MOVE CURRENT FILE NAME TO FILNAM. THE CURRENT FILE NAME IS;TERMINATED BY A ':';       LXI     B,FILNAM ;BC->FILNAM       LHLD    FILPTR   ;HL->FILENAME PARAMETER       INX     H        ;SKIP LENGTH OF FILENAME PARAMETERNEXFIL:MOV     A,M      ;A:=A CHARACTER FROM THE FILE NAME       CPI     ':'      ;IS IT A COLON?       JZ      GETDSC   ;YES, WE ARE FINISHED       STAX    B        ;NO, STORE IT IN FILNAM       INX     H        ;POINT TO       INX     B        ;   NEXT CHARACTER       JMP     NEXFIL   ;AND DO IT ONCE MORE ;;GET DISC ID;GETDSC:INX     H        ;HL->DISC ID IN FILENAME PARAMETER       MOV     C,M      ;GET       INX     H        ;  DISC ID       MOV     B,M      ;    INTO BC       INX     H        ;SKIP THE SUBSEQUENT COLON       PUSH    B        ;PUSH DISC ID ;;GET FILE TYPE;       INX     H        ;HL->FILE TYPE       MOV     B,M      ;B:=FILE TYPE       PUSH    B        ;PUSH FILE TYPE IN MSB. ;;SET UP REMAINING PARAMETERS FOR PURGE SUBROUTINE;       LXI     B,FILNAM       PUSH    B        ;PUSH ADDRESS OF FILE NAME       LHLD    DCBADR       PUSH    H        ;PUSH ADDRESS OF DCB       MVI     M,0      ;INDICATE       LXI     B,DK]BN  ;  FILE       DAD     B        ;    CLOSED       MVI     M,0 ;;DELETE THAT FILE!;       CALL    PURGE ;;SET IORESULT;       STA     IORSLT ;;RELEASE DCB AREA FROM HEAP;       LHLD    DCBADR  ;HL->TOP OF HEAP BEFORE RESERVATION       SHLD    NP      ;STORE IT AS THE NEW TOP OF HEAP        RET        SKIP;********** LOCAL DATA ********************* DCBADR:DS      2       ;ADDRESS OF DATA CONTROL BLOCK FOR FILEFILNAM:DS      8       ;FILE NAMEFILPTR:DS      2       ;ADDRESS OF FILENAME PARAMETER        END