|
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: 20558 (0x504e)
Notes: pts_type(SC)
Names: »WUASS.SC«
└─⟦f45ea3bc3⟧ Bits:30009713 Philips computer tape "WSM"
└─⟦this⟧ »WSM:UTIL/WUASS.SC«
IDENT WUASS W,REL=2.3,841211,870155940230 ** HISTORY: ** 84-12-11/CJ I.C. WSM-UTIL <-> TOSSUT REL13 IMPL. ** 83-10-06/MAER CHECK OF TOSS FORMATTED DISC ADDED. ** 83-02-28/MAER RELEASE 1.O ** 83-02-09/MAER "RETRIES-PERFORMED"-BIT MASKED OUT EJECT ENTRY GIPLFC ENTRY CHANFC ENTRY CREVOL ENTRY CREFIL ENTRY DELFIL ENTRY GETVOL ENTRY COPYDD ENTRY PRINTF ENTRY CHVOL ENTRY SURVEY ENTRY RDSECT ENTRY WRSECT ENTRY READDK ENTRY WRITDK ENTRY OPENF ENTRY CLOSEF ENTRY BCDBIN ENTRY BINBCD ENTRY RCGET ENTRY GETIND EJECT EXTRN I:EVA0 * EXTRN T:FDSP EXTRN I:RT1 EXTRN T:LOFS EXTRN T:BCDB EXTRN T:BINB EJECT CALL FORM 16=/F6A1,16 TOSS1 EQU 'TO' TOSS2 EQU 'SS' TOSS3 EQU ' R' TOSS4 EQU 'EL' EJECT *********************************************** * * PREPARE FOR INTERTASK WSMUTIL <-> TOSSUT * *********************************************** * ORDER-CODES RDCODE EQU /0082 READ-WITH-WAIT CODE WRCODE EQU /0086 WRITE-WITH-WAIT CODE TOCODE EQU /00B9 SET TIME OUT CODE * ECB FOR I. C. INTECB EQU * ECB BUFFER ECBFC DATA /0000 FILE CODE ECBBUF DATA 0 BUFFER ADDRESS ECBREQ DATA 80 REQUIRED LENGTH ECBEFF DATA 0 EFFECTIVE LENGTH ECBRC DATA 0 RETURN CODE ECBCW DATA 0 CONTROL WORD ECBCW2 DATA 0 CONTROLWORD 2 *********************************************** * * PREPARE FOR GETTING FILE-CODE OF IPL DEVICE * *********************************************** SCTIPL EQU /030C POS FOR IPL-DEVICE IN SYSTAB IPLFC1 DATA '#MU1',SCTIPL,IPLBUF,2 IPLBUF DATA 0 EJECT *********************************************** * * GET FILE-CODE FOR IPL DEVICE * * CALL: CALL GIPLFC,<TIDBIN>,<IPLFC> * *********************************************** GIPLFC EQU * CALL I:EVA0 A9 -> RECEIVING TASK LDR* A1,A9 LOAD REC. TID IN A1 ST A1,IPLFC1+2 STORE RECEVING TID LDKL A7,IPLFC1 SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 21 GET FC AD A12,-12,A13 RESTORE CREDIT RETADR CALL I:EVA0 GET ADRESS TO <IPLFC> LD A1,IPLBUF LOAD FC IN A1 STR A1,A9 STORE FILECODE ABL I:RT1 RETURN EJECT * * CHANGE FILE CODE IN ECB * CALL: * CALL CHANFC,DATASET,FILECODE * CHANFC EQU * CALL T:FDSP GET DAT-ENTRY IN A3 AND DSCB-ENTRY IN A8 LDR A6,A3 AND SAVE A3 CALL I:EVA0 GET ADDR. TO BIN LC A3,1,A9 GET NEW FC SC A3,1,A6 AND STORE IN DAT SC A3,1,A8 AND IN DSCB ABL RETUR EJECT ****************** * CREATE VOLUME ****************** CREVOL EQU * LDKL A4,'CR' LDKL A6,'V ' RF UTINF **************** * CREATE FILE **************** CREFIL EQU * LDKL A4,'CR' LDKL A6,'F ' RF UTINF * * **************** * DELETE FILE ****************** DELFIL EQU * LDKL A4,'DL' LDKL A6,'F ' RF UTINF * * EJECT **************** * PRINT FILE **************** * * PRINTF EQU * LDKL A4,'PR' LDKL A6,'F ' RF UTINF * * ********************** * COPY DISK TO DISK ********************** COPYDD EQU * LDKL A4,'CD' LDKL A6,'D ' RF UTINF ********* * PVC * ********* SURVEY EQU * LDKL A4,'PV' LDKL A6,'C ' RF UTINF EJECT * * PERFORME A CALL TO ONE OF THE ROUTINES * CRVOL,CRFILE,DLFILE,COPVOL OR PRVTOC * A1 ADDRESS TO THE WANTED ROUTINE * UTINF EQU * CALL I:EVA0 A9 = :A PBLOCK STR A4,A9 STORE TOSSUT CMD 1WORD ST A6,2,A9 STORE TOSSUT CMD 2WORD LDR A4,A9 SAVE ADRESS TO PBLOCK CALL I:EVA0 DUMMY CALL I:EVA0 DUMMY ******************************************* * * SET TIME-OUT ON OUTPUT FILECODE 99 * ******************************************* LDKL A8,INTECB LOAD ADRESS TO ECB LDKL A6,/0099 LOAD OUTPUT FILECODE STR A6,A8 STORE FILECODE IN ECB BUF LDKL A6,10 LOAD TIME-OUT ST A6,10,A8 STORE TIME-OUT IN CONTROLWORD LDKL A7,TOCODE PUT TIMEOUT CODE TO A7 SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 1 AD A12,-12,A13 RESTORE CREDIT RETADR EJECT *************************************** * * SEND A BUFFER CONTAINING TOSSUTILITY COMMAND * TO TOSSUTIL APPLICATION VIA INTERTASK COMMUNICATION * *************************************** LDKL A6,'TU' MOVE TID TO ... ST A6,10,A8 ...CONTROL WORD ST A4,2,A8 STORE BUF ADDR TO ECB LDKL A7,WRCODE PUT WRITE CODE TO A7 SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 1 AD A12,-12,A13 RESTORE CREDIT RETADR LD A1,8,A8 LOAD ECB RETCOD RF(Z) GOON1 GO ON IF CR=0 LDK A1,20 LOAD I/O-ERROR 0020 RF RET2 GOON1 EQU * ******************************************* * * SET TIME-OUT ON INPUT FILECODE 98 * ******************************************* LDKL A6,/0098 LOAD INPUT FILECODE STR A6,A8 STORE FILECODE IN ECB BUF LDKL A6,-1 LOAD TIME-OUT ST A6,10,A8 STORE TIME-OUT IN CONTROLWORD LDKL A7,TOCODE PUT TIMEOUT CODE TO A7 SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 1 AD A12,-12,A13 RESTORE CREDIT RETADR EJECT *************************************** * * SETUP INTERTASK COMMUNICATION TO RECEIVE A BUFFER * FROM TOSSUTILITY APPLICATION * *************************************** LDKL A6,'TU' MOVE TID TO ... ST A6,10,A8 ...CONTROL WORD LDKL A7,RDCODE PUT READ CODE INTO A7 SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 1 AD A12,-12,A13 RESTORE CREDIT RETADR LD A1,8,A8 LOAD ECB RETCOD RF(Z) GOON2 GO ON IF CR=0 LDK A1,20 LOAD I/O-ERROR 0020 RF RET2 GOON2 EQU * LDR* A1,A4 LOAD TOSSUT RC RF RET2 EJECT * * GET VOLUME NAME TO A STRING VARIABEL * SYNTAX: CALL GETVOL,DSET,BUFFER,VOLNAM,RETCOD * 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 SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 1 AD A12,-12,A13 RESTORE CREDIT RETADR LD A1,8,A8 LOAD RETURN CODE ANKL A1,/F6FF MASK OUT BIT FOR 1MB FLOPPY AND "RETRIES PERFORMED" RF(NZ) RET2 EJECT * 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 RET EQU * LD A1,8,A8 LOAD RETURN CODE RET1 EQU * ANKL A1,/F6FF MASK OUT BIT FOR 1MB FLOPPY AND "RETRIES PERFORMED" RET2 EQU * LDR A6,A1 SAVE RETCOD CALL I:EVA0 STR A6,A9 STORE RETURN-CODE LDR A6,A6 RF(Z) RET3 LDK A6,1 RET3 EQU * LD A4,2,A13 GET STACK BASE SC A6,-2,A4 STORE CR ON STACK RETUR EQU * ABL I:RT1 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 SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 1 AD A12,-12,A13 RESTORE CREDIT RETADR LD A6,8,A8 GET RETURN CODE LDK A7,/81 BASIC READ SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 1 AD A12,-12,A13 RESTORE CREDIT RETADR CALL I:EVA0 GET VOLUME NAME EJECT LD A7,2,A8 LOAD BUFFER POINTER ML 4,32,A7 A1-A4 := TOSS DISC ID SUKL A1,TOSS1 CHECK IF TOSS FORMATTED RF(NZ) NOTOSS -NO SUKL A2,TOSS2 RF(NZ) NOTOSS SUKL A3,TOSS3 RF(NZ) NOTOSS SUKL A4,TOSS4 RF(NZ) NOTOSS EJECT ******************************* * REPLACE CURRENT VOLUME NAME * ******************************* LDR A1,A7 THE DISC IS TOSS FORMATTED! 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 SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 1 AD A12,-12,A13 RESTORE CREDIT RETADR LDK A7,/80 TEST STATUS SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 1 AD A12,-12,A13 RESTORE CREDIT RETADR LDK A1,0 INDICATE TOSS FORMATTED RF CHV300 NOTOSS EQU * NOT A TOSS FORMATTED DISC LDK A1,/42 LOAD RETURN CODE CHV300 EQU * LDR A6,A6 RF(NZ) CHV400 JUMP IF NOT TO BE UNLOADED LDK A7,/B8 UNLOCK SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 1 AD A12,-12,A13 RESTORE CREDIT RETADR CHV400 EQU * LDR A1,A1 TOSS DISC? RB(NZ) RET1 -NO, USE EXISTING A1-VALUE RB RET EJECT * * CALL WRSECT,DSET,RECNO,BUF,RETCOD * * DSET EVENT CONTROL BLOCK * RECNO REALATIV SECTOR NO WITHIN THE FILE * BUF BUFFER * RETCOD RETURN CODE FROM LKM * * WRSECT EQU * LDKL A11,/85 BASIC WRITE RF RDS000 * * * * CALL RDSECT,DSET,RECNO,BUF,RETCOD * DSET EVENT CONTROL BLOCK * RECNO REALATIV SECTOR NO WITHIN THE FILE * BUF BUFFER * RETCOD RETURN CODE FROM LKM * * RDSECT EQU * LDKL A11,/81 BASIC READ RDS000 EQU * CALL T:FDSP CALL I:EVA0 LDR* A1,A9 CM 10,A8 ST A1,12,A8 STORE SECTOR NUMBER EJECT 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 SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 1 AD A12,-12,A13 RESTORE CREDIT RETADR LD A6,8,A8 GET RETURN CODE LDR A7,A11 * A7 ORDER CODE * A8 DSET ADDRESS SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 1 AD A12,-12,A13 RESTORE CREDIT RETADR LDK A1,0 NO FORMAT ERROR! RB CHV300 EJECT * * CALL WRITDK,DSET,FILECODE,BUF,LEN,RECNO,RETCOD * RETCOD RETURN CODE FROM LKM * * 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 * * CALL READDK,DSET,FILECODE,BUF,LEN,RECNO,RETCOD * * DSET EVENT CONTROL BLOCK * FILECODE FILE NUMBER * BUF BUFFER * LEN REQUESTED LENGTH * RECNO RELATIVE SECTOR NO WITHIN THE FILE * RETCOD RETURN CODE FROM LKM * READDK EQU * LDKL A11,/91 ORDER CODE READ00 EQU * CALL T:FDSP GET DSET ADDRESS TO A8 EJECT * 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 CALL T:BCDB COVERT TO TWO BINARYS ST A2,12,A8 LEAST SIGNIFICANT ST A1,10,A8 MOST SIGNIFICANT READ20 EQU * LDR A7,A11 * A7 ORDER CODE * A8 DSET ADDRESS SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 15 AD A12,-12,A13 RESTORE CREDIT RETADR READ40 EQU * ABL RET EJECT * * CALL CLOSEF,DSET,FILECODE,BUFF,RECNO,RETCOD * * DSET EVENT CONTROL BLOCK * FILECODE FILE NUMBER * BUF FILE PARAMETER BUFFER * RECNO NUMBER OF RECORDS IN SPEC. FILE * * RETCOD RETURN CODE FROM LKM CLOSEF EQU * LDR A11,A14 RF OPENF0 CLOS10 EQU * CALL T:BCDB CONVERT TO TWO BINARYS LD A6,2,A8 ADR TO FPB ST A1,58,A6 LEAST SIGNIFICANT ST A2,60,A6 MOST SIGNIFICANT LDR* A6,A10 GET STORED FILECODE SC A6,1,A8 PUT INTO ECB LDKL A11,/A2 LOAD ORDER CODE RB READ20 EJECT * * CALL OPENF,DSET,FILECODE,BUF,FILE,VOLUME,RETCOD * * DSET EVENT CONTROL BLOCK * FILECODE FILE NUMBER * BUF FILE PARAMETER BUFFER * FILE FILE NAME * VOLUME VOLUME NAME * RETCOD RETURN CODE FROM LKM * 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 EJECT * * 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 EJECT * * 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 SU A12,-12,A13 SAVE RETADRESS IF DISKPAGING LKM DATA 15 AD A12,-12,A13 RESTORE CREDIT RETADR * STORE FILE CODE IN FILE CODE BUFFER LC A3,1,A8 STR A3,A10 RB READ40 CHEC ON ERROR CODE EJECT * * CONVERT A BCD-ITEM TO TWO BINARY-ITEMS * * CALL BCDBIN,BCD,BINMS,BINLS * BCDBIN EQU * CALL I:EVA0 GET AD TO BCD CALL T:BCDB CONVERT WITH RESULT IN A1,A2 STR A1,A14 SAVE A1 ON STACK ST A2,-2,A14 SAVE A2 ON STACK SUKL A14,4 UPDATE STACK-POINTER CALL I:EVA0 GET ADR TO BINMS LD A1,4,A14 GET VALUE OF BINMS STR A1,A9 PUT VALUE IN BINMS CALL I:EVA0 GET AD TO BINLS LD A2,2,A14 GET VALUE OF BINLS STR A2,A9 PUT VALUR IN BINLS ADKL A14,4 UPDATE STACKPOINTER ABL I:RT1 RETURN TO CALL-MODULE EJECT * * CONVERT TWO BINARY-ITEMS TO A BCD-ITEM * * CALL BINBCD,BINMS,BINLS,BCD * BINBCD EQU * CALL I:EVA0 GET ADR OF BINMS LDR* A9,A9 GET VALUE OF BINMS STR A9,A14 SAVE A9 ON STACK SUKL A14,2 UPDATE STACK-POINTER CALL I:EVA0 GET ADR OF BINLS LDR* A9,A9 GET VALUE OF BINLS STR A9,A14 SAVE A9 ON STACK SUKL A14,2 UPDATE STACK-POINTER CALL I:EVA0 GET ADR TO BCD ADKL A14,4 UPDATE STACKPOINTER LDR* A2,A14 GET VALUE OF BINMS LD A1,-2,A14 GET VALUE OF BINLS CALL T:BINB CONVERT WITH BCD UPDATED ABL I:RT1 RETURN TO CALLING MODULE EJECT RCGET EQU * CALL I:EVA0 GET PARAM. ONE LDR* A4,A9 GET CONTENTS OF PAR1 CALL I:EVA0 GET PARAM. TWO LDKL A2,/396C INSTRUCTION SRL A1,12 LDK A3,4 LOOPCOUNTER RC10 EQU * LDR A1,A4 EXR A2 EXECUTE INSTRUCTION ANK A1,/F PICK ONE NUMERIC CWK A1,9 CONVERT BIN -> ASCII RF(G) RC20 CONVERT BIN -> ASCII ADK A1,/30 -"- RF RC30 -"- RC20 EQU * -"- ADK A1,/37 -"- RC30 EQU * -"- SCR A1,A9 STORE IN PARAM.2 ADKL A9,1 SUK A2,4 MODIFY SHIFTINSTR. SUK A3,1 LOOP-COUNTER RB(P) RC10 JMP CR>0 ABL I:RT1 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 NO. OF ELEMENTS * * * GETIND EQU * CALL I:EVA0 ADDRESS TO ITEM LD A10,-6,A14 READ DIMENSION STORED BYE I:EVA 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 ITEM STR A10,A9 STORE DIMENSION ABL I:RT1 END