|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 5600 (0x15e0)
Notes: Mikados TextFile, Mikados_K
Names: »PURGEF«
└─⟦38ff28550⟧ Bits:30004682 Pascal Standard Assembler til MIKADOS
└─ ⟦this⟧ »PURGEF«
;*************************************************************
;* 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 PARAMETER
NEXFIL: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 FILE
FILNAM:DS 8 ;FILE NAME
FILPTR:DS 2 ;ADDRESS OF FILENAME PARAMETER
END