|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 20678 (0x50c6)
Notes: pts_type(SC)
Names: »ASSRUT.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DU/ASSRUT.SC«
└─⟦79fbed147⟧ Bits:30009697 Philips computer tape "600414"
└─⟦this⟧ »S:DU/ASSRUT.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DU/ASSRUT.SC«
IDENT ASSRUT UPD 80-03-20/CHST UPD 80-02-22/CHST UPD 80-01-16/CHST UPD 79-11-08/PEEN UPD 79-01-30/PEEN * ASSEMBLER ROUTINES USED BY PTS DE-UTILITIES ENTRY CHANFC ENTRY CREVOL ENTRY CREFIL ENTRY DELFIL ENTRY GETVOL ENTRY COPYDD ENTRY GETFRE ENTRY CHVOL ENTRY SURVEY ENTRY UPDBOL ENTRY UPDBIN ENTRY SETB ENTRY TESTB ENTRY CLEARB ENTRY MSKOUT ENTRY RDSECT ENTRY SETOCC ENTRY SETFRE ENTRY VOLNAM ENTRY ATTWB ENTRY CMPIND ENTRY GETIND ENTRY RESTOR ENTRY WRITDK ENTRY READDK ENTRY CLOSEF ENTRY OPENF * EXTRN I:EVA0 EXTRN CRVOL EXTRN CRFILE EXTRN DLFILE * COPY SYSVOL TO SYSVOL NOT IN THIS REL. * EXTRN COPVOL EXTRN PRVTOC * EXTRN T:FDSP EXTRN I:RT1 EXTRN T:LOFS * CALL FORM 16=/F6A1,16 EJECT * * CHANGE FILE CODE IN ECB * CALL: * CALL CHANFC,DATASET,FILECODE * CHANFC EQU * CF A14,T:FDSP GET ECB-ADDRESS CF A14,I:EVA0 GET ADDRESS TO BIN. LC A3,1,A9 GET FILE CODE SC A3,1,A8 STORE FILE CODE IN ECB RF RET EJECT ****************** * CREATE VOLUME ****************** CREVOL EQU * LDKL A1,CRVOL CALL UTINF EJECT * * PERFORME A CALL TO ONE OF THE ROUTINES * CRVOL,CRFILE,DLFILE,COPVOL OR PRVTOC * A1 ADDRESS TO THE WANTED ROUTINE * UTINF EQU * ST A1,RUTIN CF A14,I:EVA0 A9 = :A PBLOCK LDR A6,A9 ADRESS TO PBLOCK CF A14,I:EVA0 A9 = :A BUF1 STR A9,A6 STORE BUF1 ADRESS CF A14,I:EVA0 A9 = :A BUF2 ST A9,2,A6 STORE BUF2 ADRESS STR A12,A14 SAVE A12 ST A13,-2,A14 SAVE A13 SUKL A14,4 LDR A12,A6 CF A14,CRVOL RUTIN EQU *-2 ADKL A14,4 LD A13,-2,A14 LDR* A12,A14 LDR A6,A1 SAVE RETURN CODE CF A14,I:EVA0 GET ADRESS TO RETCOD STR A6,A9 ADKL A14,4 ABL I:RT1 EJECT **************** * CREATE FILE **************** CREFIL EQU * LDKL A1,CRFILE CALL UTINF EJECT **************** * DELETE FILE ****************** DELFIL EQU * LDKL A1,DLFILE CALL UTINF EJECT * COPY SYSVOL TO SYSVOL IS NOT IMPLEMENTED IN THIS REL. ********************** * COPY DISK TO DISK ********************** COPYDD EQU * * LDKL A1,COPVOL * CALL UTINF ABL I:RT1 EJECT * GET VOLUME NAME TO A STRING VARIABEL * SYNTAX: CALL GETVOL,DSET,BUFFER,VOLNAM,RETCOD * RETCOD = 0 IF OK, ELSE 1 * GETVOL EQU * CALL T:FDSP GET DSET ADDRESS TO A8 CALL I:EVA0 GET BUFFER ADDRESS TO A9 ADKL A9,1 MAKE BUFFER ADDRESS EVEN ANKL A9,/FFFE ST A9,2,A8 STORE BUFFER ADDRESS IN DSET LDK A6,6 REQUESTED LENGTH =6 ST A6,4,A8 => VOLUME NAME AS OUTPUT TEST STATUS CALL I:EVA0 GET ADDRESS TO VOLNAM LDK A7,/80 LOAD ORDER CODE * A7 ORDER CODE FOR TEST STATUS * A8 DSET ADDRESS LKM DATA 1 LD A1,8,A8 LOAD RETURN CODE RF(NZ) ERROR * STORE THE VOLUME NAME (OUTPUT FROM TEST STATUS) * IN CALLERS BUFFER VOLNAM LD A1,2,A8 LOAD BUFFER ADDRESS LDK A2,6 NO OF BYTES IN VOLUME NAME LOOP EQU * LCR A3,A1 SCR A3,A9 ADK A1,1 ADKL A9,1 SUK A2,1 RB(P) LOOP UT EQU * LDK A6,0 VIN CF A14,I:EVA0 STR A6,A9 STORE RETURN-CODE RET ABL I:RT1 ERROR LDK A6,1 RB VIN EJECT * GET A FREE RECORD FROM FREE-SPACE RECORD * SYNTAX: CALL GETFRE,BPOOL(IND),RPOOL(IND),NUMB * OUTPUT: NUMB = FOUND RECORD NUMBER (=0 IF NOT FOUND) GETFRE EQU * CALL GETPAR GET PARAMETER ADDRESSES LD A4,-2,A7 GET NUMBER OF FRE RECORDS RF(Z) NOK IF NONE FREE GET100 EQU * CWR A7,A8 RF(E) NOK END OF RECORD LCR A4,A7 GET BITS FOR 8 RECORDS SLL A4,8 SHIFT TO RIGHTMOST RF(NZ) SEARCH AT LEAST ONE RECORD FREE ADK A7,1 INCREMENT POINTER ADK A6,8 UPDATE RECORD NUMBER RB GET100 SEARCH EQU * LDK A5,0 INDICATE FIRST BIT IN BYTE LDR A4,A4 SEA100 RF(N) FOUND IF FOUND ADK A5,1 INCREMENT COUNTER SLL A4,1 RB SEA100 FOUND SLL A4,1 CLEAR BIT ADR A6,A5 UPDATE RELATIVE RECORD NUMBER FOU100 SRL A4,1 SUK A5,1 DECREMENT POINTER RB(NN) FOU100 SRL A4,8 SCR A4,A7 STORE UPDATED BYTE LC A7,17,A9 ECR A7,A7 LC A7,18,A9 GET START RECORD NUMBER ADR A6,A7 GET CURRENT RECORD NUMBER LDKL A1,-1 ADRS A1,A2 DECREMENT NO. OF FREE RECS. NOK EQU * CALL I:EVA0 NOK100 STR A6,A9 STORE FOUND INDEX RB RET EJECT GETPAR EQU * CALL I:EVA0 ADDRESS TO BPOOL LDR A7,A9 COPY ADDRESS CALL I:EVA0 ADDRESS TO RPOOL LC A8,15,A9 ECR A8,A8 LC A8,16,A9 GET OCCUPIED BYTES ADR A8,A7 GET END ADDRESS SUKL A8,10 LDR A2,A7 SAVE START ADDRESS ADK A7,2 ADDRESS TO FIRST BITS LDK A6,0 RTN A14 EJECT ************************ * CHANGE VOLUME NAME * ************************ CHVOL EQU * CALL T:FDSP CM 10,A8 SECTOR NO. = 0 CM 12,A8 CHV100 LDKL A1,256 ST A1,4,A8 STORE REQUESTED LENGTH CALL I:EVA0 ST A9,2,A8 STORE BUFFER ADRESS LDK A7,/B7 LOCK LKM DATA 1 LD A6,8,A8 GET RETURN CODE LDK A7,/81 BASIC READ LKM DATA 1 CALL I:EVA0 GET VOLUME NAME LD A1,2,A8 LDK A2,6 CHV200 LCR A3,A9 READ CHARACTER SCR A3,A1 STORE CHARACTER ADK A1,1 ADKL A9,1 SUK A2,1 RB(NZ) CHV200 IF NOT FINISHED LDK A7,/85 WRITE BASIC LKM DATA 1 LDK A7,/80 LKM DATA 1 LDR A6,A6 RF(NZ) CHVUT JUMP IF NOT TO BE UNLOADED LDK A7,/B8 LKM DATA 1 CHVUT EQU * ABL I:RT1 EJECT ********* * PVC * ********* SURVEY EQU * LDKL A1,PRVTOC CALL UTINF EJECT * * MOVE CONTENTS OF BIN ITEM TO CORRESPONDING * 16 BOOLEAN ITEMS * UPDBOL EQU * CALL I:EVA0 GET ADDRESS TO BIN ITEM LDR* A1,A9 GET BIN CONTENTS ST A1,-2,A9 STORE BOOLEANS ABL I:RT1 * * MOVE 16 BOOLEAN ITEMS TO CORRESPONDING BIN * UPDBIN EQU * CALL I:EVA0 GET ADDRESS TO BIN ITEM LD A1,-2,A9 GET BOOLEANS STR A1,A9 STORE IN BIN ABL I:RT1 EJECT * * SEARCH WANTED BIT IN A CHARACTER STRING * A3 = BIT INDEX * A7 = CHARACTER STRING START ADDRESS * SEABIT EQU * SET050 SUK A3,8 RF(N) SET100 ADK A7,1 CWR A7,A8 RB(NE) SET050 CONTINUE IN NOT EOR LDK A6,0 INDICATE INCORRECT REC. NO. RTN A14 * PLACED IN CURRENT BYTE SET100 EQU * ADK A3,8 LCR A4,A7 SLL A4,8 GET BYTE RIGHTMOST LDR A1,A3 COPY A3 RF(Z) TEST IF FIRST BIT SET300 EQU * SLC A4,1 SUK A1,1 RB(NZ) SET300 TEST EQU * RTN A14 EJECT * * SET WANTED BIT IN A STRING OR BIN ITEM * SYNTAX: CALL SETB,ITEM,INDEX * SETB EQU * SUR A10,A10 INDICATE 'SET' SETB10 EQU * CALL I:EVA0 GET ADDRESS TO ITEM LDR A7,A9 COPY ADDRESS LDR A8,A5 COPY ENDADDRESS CALL I:EVA0 GET ADDRESS TO INDEX LDR* A3,A9 GET INDEX CALL SEABIT SEARCH WANTED BIT LDR A10,A10 RF(N) SETB30 IF TEST BIT RF(Z) SETB20 JUMP IF SETBIT * CLEAR BIT ANKL A4,/7FFF CLEAR BIT RF TES200 RESTORE BYTE * SET BIT SETB20 EQU * ORKL A4,/8000 SET BIT RF TES200 RESTORE BYTE SETB30 EQU * LDK A1,0 INDICATE FALSE LDR A4,A4 TEST BIT RF(NN) SETB40 IF FALSE LDK A1,1 INDICATE TRUE SETB40 EQU * LD A4,2,A13 GET STACK BASE SC A1,-2,A4 STORE CR ON STACK ABL I:RT1 * * CLEAR BIT IN STRING OR BIN VARIABLE * SYNTAX: CALL CLEARB,ITEM,INDEX * CLEARB EQU * LDKL A10,1 INDICATE 'CLEAR BIT' RB SETB10 CONTINUE * * TEST BIT IN STRING OR BIN VARIABLE * SYNTAX: CALL TESTB,ITEM,INDEX * OUTPUT: CR = 0 (BIT IS FALSE) * CR = 1 (BIT IS TRUE) * TESTB EQU * LDKL A10,-1 INDICATE 'TEST BIT' RB SETB10 CONTINUE EJECT * * MASK OUT WANTED BITS ACCORDING TO MASK * SYNTAX: CALL MSKOUT,MASK,BIN * MASK= BIN ITEM HOLDING THE MASK; WILL CONTAIN * THE RESULT AFTER THE LOGICAL AND OPERATION * BIN= BIN HOLDING THE VALUE TO BE MASKED * MSKOUT EQU * CALL I:EVA0 ADDRESS TO MASK LDR A6,A9 CALL I:EVA0 ADDRESS TO BIN LDR* A1,A9 GET CONTENTS OF BIN ANRS A1,A6 LOGICAL AND WITH MASK AND STORE RESULT IN MASK ABL I:RT1 * EJECT ********************** * READ DISK SECTOR * ********************** RDSECT EQU * CALL T:FDSP CALL I:EVA0 LDR* A1,A9 CM 10,A8 ST A1,12,A8 STORE SECTOR NUMBER RDS100 LDKL A1,256 ST A1,4,A8 STORE REQUESTED LENGTH CALL I:EVA0 ST A9,2,A8 STORE BUFFER ADRESS LDK A7,/B7 LOCK LKM DATA 1 LDK A7,/81 BASIC READ LKM DATA 1 LDK A7,/B8 UNLOCK LKM DATA 1 RET1 ABL I:RT1 EJECT * SETFRE: INDICATE RECORD FREE AND UPDATE NO.OF * FREE RECORD COUNTER. THIS IS ONLY DONE * IF CURRENT RECORD WAS BUSY * SYNTAX: CALL SETFRE,BPOOL(IND),RPOOL(IND),NUMB * NUMB = CURRENT RECORD NUMBER (=0 IF WRONG NUMBER) * SETFRE EQU * SUR A10,A10 INDICATE SETFRE SET EQU * CALL GETPAR LDR A6,A9 COPY ADDRESS CALL I:EVA0 GET ADDRESS TO REC. NO. LDR A2,A7 COPY A7 LDR* A3,A9 GET INDEX LC A1,17,A6 ECR A1,A1 LC A1,18,A6 GET START RECORD NUMBER SUR A3,A1 GET RELATIVE RECORD NO. CALL SEABIT SEARCH WANTED BIT LDR A6,A6 RF(Z) NOK150 JUMP IF ERROR LDR A10,A10 RF(NZ) TEST0 IF SET0CC * SETFRE: TEST IF ALREADY FREE TEST1 LDR A4,A4 RB(N) RET1 IF ALREADY FREE ORKL A4,/8000 SET RECORD FREE LDK A1,1 INDICATE INCREMENT TES100 ADS A1,-2,A2 IN-/DE-CREMENT COUNTER TES200 SUK A3,1 RF(N) TES300 BYTE RESTORED SRC A4,1 RB TES200 TES300 SRL A4,8 MOVE TO RIGHTMOST BYTE SCR A4,A7 STORE UPDATED BYTE RB RET1 * * SETOCC: TEST IF ALREADY OCCUPIED TEST0 EQU * LDR A4,A4 RB(NN) RET1 IF ALREADY OCCUPIED SUK A1,1 A1 = -1; INDICATE DECREMENT ANKL A4,/7FFF INDICATE OCCUPIED RB TES100 NOK150 EQU * STR A6,A9 RB RET1 EJECT * SET RECORD OCCUPIED AND DECREMENT NUMBER OF * FREE RECORDS; THIS IS ONLY DONE IF CURRENT RECORD * IS FREE * SYNTAX: CALL SETOCC,BPOOL(IND),RPOOL(IND),NUMB * NUMB = CURRENT RECORD NUMBER (= 0 AS OUTPUT IF * WRONG NUMBER) SETOCC EQU * LDR A10,A14 INDICATE SETOCC RB SET * * VOLNAM - SUBROUTINE TO CRVOL * * VOLNAM EQU * LDK A1,0 RTN A14 EJECT * * ATTACH A STRING VARIABLE AS WORKBLOCK TO * THE TERMINAL CONTROL AREA * SYNTAX: CALL ATTWB,STRG,DISPL,BLOCK * STRG= STRING ITEM TO BE WORKBLOCK * DISPL= BIN ITEM HOLDING DISPLACEMENT RELATIVE * 'STRG'-START * BLOCK= BIN ITEM HOLDING BLOCK NUMBER WITHIN T:A * ATTWB EQU * LDKL A10,2 INDICATE WB ATT EQU * CALL I:EVA0 ADDRESS TO NEW WB LDR A7,A9 SAVE ADDRESS CALL I:EVA0 GET DISPLACEMENT ADR* A7,A9 CALL I:EVA0 ADDRESS TO WB NUMBER LDR* A1,A9 SLL A1,2 TIMES 4 ADR A1,A13 ADDRESS TO DB ADR A1,A10 GET ADDRESS TO WB OR DB ATT100 EQU * STR A7,A1 STORE NEW WB/DB-ADDRESS RB RET1 EJECT * * SAVE POINTERS TO DB:S/WB:S IN STRING ITEM * SYNTAX: CALL SAVE,DISPL,LENGTH,STRG * DISPL= BIN ITEM HOLDING DISPLACEMENT RELATIVE * THE VERY FIRST DB:POINTER * LENGTH= BIN ITEM HOLDING THE NUMBER OF BYTES TO BE MOVED * STRG= STRING VARIABLE TO STORE THE SAVED POINTERS IN * SAVE EQU * CALL GETP GET PARAMETERS SAV100 EQU * ADR A2,A7 ADR A7,A9 SAV200 EQU * LCR A1,A2 SCR A1,A7 ADK A2,1 ADK A7,1 SUK A6,1 RB(NZ) SAV200 RB RET1 * * RESTORE DB/WB-POINTERS FROM A STRING VARIABLE * TO THE T:A (TERMINAL CONTROL AREA) * SYNTAX: CALL RESTOR,DISPL,LENGTH,STRG * DISPL= DISPLACEMENT RELATIVE THE VERY FIRST DB-POINTER * LENGTH= NUMBER OF BYTES TO RESTORE * STRG= STRING ITEM HOLDING POINTERS TO BE RESTORED * RESTOR EQU * CALL GETP LDR A1,A2 LDR A2,A9 CHANGE LDR A9,A1 ADDRESSES RB SAV100 START TO RESTORE * * GET PARAMETERS FOR SAVE/RESTORE * GETP EQU * CALL I:EVA0 LDR* A7,A9 START DISPLACEMENT CALL I:EVA0 LDR* A6,A9 GET LENGTH CALL I:EVA0 LDK A2,40 ADR A2,A13 GET ADDRESS TO DB-POINTER /A RTN A14 EJECT * * GET DIMENSION OF INDEXED VARIABLE AND LENGTH * * SYNTAX: CALL GETIND,ITEM(W1),LENGTH,DIMENSION * * ITEM(W1) = CURRENT ITEM * LENGTH = BIN HOLDING ITEM LENGTH * DIMENSION = BIN HOLDING DIMENSION * (NUMBER OF ELEMENTS) * GETIND EQU * CALL I:EVA0 ADDRESS TO ITEM LD A10,-6,A14 READ DIMENSION STORED BY I:EVA0 LDR A7,A5 COPY END ADDRESS SUR A7,A9 CALCULATE ITEM LENGTH CALL I:EVA0 ADDRESS TO LENGTH ITEM STR A7,A9 STORE LENGTH CALL I:EVA0 ADDRESS TO DIMENSION STR A10,A9 STORE IN ITEM ATTRET EQU * RB RET1 EJECT * * COMPARE INDEX VARIABLE WITH DIMENSION OF INDEXED ITEM * * SYNTAX: CALL CMPIND,INDEX,ITEM(INDEX1) * * OUTPUT: CR = 0 IF INDEX=MAX. INDEX OF ITEM * CR = 1 IF INDEX>MAX. INDEX OF ITEM * CR = 2 IF INDEX<MAX. INDEX OF ITEM * CMPIND EQU * CALL I:EVA0 GET ADDRESS TO INDEX LDR* A6,A9 SAVE INDEX VALUE CALL I:EVA0 GET ADDRESS AND DIMENSION OF ITEM LDR A6,A6 RF(NP) LESS CW A6,-6,A14 COMPARE WITH DIMENSION RF(G) GREAT * EQUAL EQU * UT150 EQU * LDK A1,0 INDICATE CR = 0 UT200 EQU * ABL SETB40 STORE CR AND RETURN GREAT EQU * NOTFND EQU * LDK A1,1 INDICATE CR = 1 RB UT200 STORE CR AND RETURN LESS EQU * LDK A1,2 RB UT200 EJECT * * CALL WRITDK,DSET,FILECODE,BUF,LEN,RECNO * * DSET EVENT CONTROL BLOCK * FILECODE FILE NUMBER * BUF BUFFER * LEN REQUESTED LENGTH * RECNO REALATIV SECTOR NO WITHIN THE FILE * WRITDK EQU * LDKL A11,/95 ORDER CODE RF READ00 EJECT * * CALL READDK,DSET,FILECODE,BUF,LEN,RECNO * * DSET EVENT CONTROL BLOCK * FILECODE FILE NUMBER * BUF BUFFER * LEN REQUESTED LENGTH * RECNO RELATIVE SECTOR NO WITHIN THE FILE * READDK EQU * LDKL A11,/91 ORDER CODE READ00 EQU * CALL T:FDSP GET DSET ADDRESS TO A8 * GET PARAMETERS FROM PARAMETER LIST AND STORE * THEM IN DSET CALL I:EVA0 FILE CODE LDR* A6,A9 SC A6,1,A8 CALL I:EVA0 BUFFER ADDRESS ST A9,2,A8 CALL I:EVA0 RECORD LENGTH LDR* A6,A9 ST A6,4,A8 CALL I:EVA0 RECORD NO LDR* A6,A9 ST A6,12,A8 CM 10,A8 LDR A7,A11 READ20 EQU * * A7 ORDER CODE * A8 DSET ADDRESS LKM DATA 15 * * CHECK ON ERROR CODE READ40 EQU * LD A6,8,A8 RB(Z) EQUAL SET COND CODE TO 0 ,OK ANKL A6,/2000 RB(NZ) GREAT SET COND CODE TO 1 ,EOF RB LESS SET COND CODE TO 2 ,ERROR * EJECT * * CALL CLOSEF,DSET,FILECODE,BUFF,RECNO * * DSET EVENT CONTROL BLOCK * FILECODE FILE NUMBER * BUF FILE PARAMETER BUFFER * RECNO NUMBER OF RECORDS IN SPEC. FILE * CLOSEF EQU * LDR A11,A14 RF OPENF0 CLOS10 LDR* A1,A9 GET REC.NO. ST A1,60,A6 LDR* A6,A10 SC A6,1,A8 LDK A7,/A2 LOAD ORDER CODE RB READ20 EJECT * * CALL OPENF,DSET,FILECODE,BUF,FILE,VOLUME * * DSET EVENT CONTROL BLOCK * FILECODE FILE NUMBER * BUF FILE PARAMETER BUFFER * FILE FILE NAME * VOLUME VOLUME NAME * OPENF EQU * SUR A11,A11 OPENF0 EQU * CALL T:FDSP GET DSET ADDRESS TO A8 CALL I:EVA0 SAVE ADDRESS TO FILE CODE LDR A10,A9 CALL I:EVA0 GET ADDRESS TO FPB(FILE PARAM.BUF) ADKL A9,1 AND MAKE SURE IT IS EVEN ANKL A9,/FFFE LDR A6,A9 SAVE ADDRESS TO FPB ST A9,2,A8 STORE THE ADDRESS IN DSET LDK A3,80 NO OF BYTES IN FPB LDR A2,A9 ADDRESS TO FPB OPEN00 EQU * CMR A2 STORE ZERO IN FPB ADK A2,2 INCREACE ADDRESS SUK A3,2 RB(NZ) OPEN00 * * GET FILE NAME AND STORE IT IN FPB * A3 CONTAINES FPB ADDRESS CALL I:EVA0 LDR A11,A11 RB(NZ) CLOS10 ADK A6,8 ADDRESS TO FILE NAME IN FPB LDK A4,8 NO OF CHAR IN FILE NAME OPEN20 EQU * LCR A3,A9 GET ON CHAR SCR A3,A6 STORE ONE CHAR IN FPB ADKL A9,1 ADK A6,1 SUK A4,1 RB(NZ) OPEN20 * * GET VOLUME NAME AND STORE IT IN FPB CALL I:EVA0 ADK A6,2 ADDRESS TO VOLUME IN FPB LDK A4,6 NO OF CHAR IN VOLUME NAME OPEN40 EQU * LCR A3,A9 SCR A3,A6 STORE ONE CHAR IN FPB ADKL A9,1 ADK A6,1 SUK A4,1 RB(NZ) OPEN40 LDK A7,/A1 LOAD ORDER CODE LKM DATA 15 * STORE FILE CODE IN FILE CODE BUFFER LC A3,1,A8 STR A3,A10 RB READ40 CHEC ON ERROR CODE END