From 4b643ea646d302d3610452b84a7d362ddcfe5559 Mon Sep 17 00:00:00 2001 From: d_m Date: Sat, 14 Sep 2024 01:22:04 -0400 Subject: [PATCH] tar listing seems to be working --- arg.tal | 2 +- tar.tal | 95 ++++++++++++++++++++++++++++++++++++++++++++++++--------- 2 files changed, 81 insertions(+), 16 deletions(-) diff --git a/arg.tal b/arg.tal index 879a3a6..ee3e7df 100644 --- a/arg.tal +++ b/arg.tal @@ -61,7 +61,7 @@ ( internal: store character c in the buffer and update position ) &save ( c^ -> ) - LIT2r :arg/pos LDA2kr STH2r ( c^ addr* [pos*] ) + LIT2r =arg/pos LDA2kr STH2r ( c^ addr* [pos*] ) STA LDA2kr INC2r SWP2r ( [addr1* pos*] ; addr<-c ) STA2r JMP2r ( ; pos<-addr+1 ) diff --git a/tar.tal b/tar.tal index 06c79e8..f673b4f 100644 --- a/tar.tal +++ b/tar.tal @@ -50,21 +50,21 @@ @list ( -> ) read-header ?&ok JMP2r &ok + ( dump-header ) ;header/filename LDA ?&non-null #800f DEO BRK &non-null ;header/type LDA ( type^ ) - DUP #00 EQU ?list-file ( ) - DUP LIT "0 EQU ?list-file ( ) - DUP LIT "5 EQU ?list-dir ( ) + DUP #00 EQU ?list-file-v ( ) + DUP LIT "0 EQU ?list-file-v ( ) + DUP LIT "5 EQU ?list-dir-v ( ) !list-unsupported ( ) @list-file ( 00^ -> ) POP LIT "f #18 DEO #2018 DEO ;header/filename print #0a18 DEO - ;header/size load-octal11 - round-up-to-512 skip !list + ;header/size load-octal11 round-up-to-512 skip !list @list-dir ( 00^ -> ) POP @@ -72,6 +72,30 @@ ;header/filename print #0a18 DEO !list +@list-file-v ( 00^ -> ) + POP + LIT "f #18 DEO #2018 DEO +( ;header/mode #0008 dump-mem0 ) +( ;header/owner #0008 dump-mem0 ) +( ;header/group #0008 dump-mem0 ) +( ;header/size #000b dump-mem0 ) +( ;header/mtime #000b dump-mem0 ) + ;header/size load-octal11 dump-longer #2018 DEO + ;header/filename print #0a18 DEO + ;header/size load-octal11 round-up-to-512 skip !list + +@list-dir-v ( 00^ -> ) + POP + LIT "d #18 DEO #2018 DEO +( ;header/mode #0008 dump-mem0 ) +( ;header/owner #0008 dump-mem0 ) +( ;header/group #0008 dump-mem0 ) +( ;header/size #000b dump-mem0 ) +( ;header/mtime #000b dump-mem0 ) + ;header/size load-octal11 dump-longer #2018 DEO + ;header/filename print #0a18 DEO + !list + @list-unsupported ( type^ -> ) ;unsupported print emit/byte #0a18 DEO !panic !list @@ -150,11 +174,11 @@ &ok JMP2r @octal-digit ( char^ -> oct^ ) - LIT "0 DUP2 LTH ?&zero SUB JMP2r &zero POP2 #00 JMP2r + LIT "0 LTHk ?&zero SUB JMP2r &zero POP2 #00 JMP2r ( returns values between #00:0000:0000 and #01:ffff:ffff ) @load-octal11 ( addr* -> carry^ hi* lo* ) - INC2k load-octal10 ( addr* hi* lo* ) + INC2k load-octal10 ( addr* hi* lo* ; load addr+1 ) STH2 STH2 ( addr* [lo* hi*] ) LDA ( LIT "0 SUB ) octal-digit STH2r STH ( octal^ a^ [lo* b^] ) #20 SFT #02 SFT2 STHr STH2r ( carry^ hi* lo* ) @@ -190,14 +214,55 @@ JMP2r ( round a given 5-byte size up to multiples of 512 ) -@round-up-to-512 ( carry^ hi* lo* -> ) - DUP2 #fe00 GTH2 ?&round-hi - #0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r - &round-hi - POP2 DUP2 #ffff EQU2 ?&round-carry INC2 #0000 JMP2r - &round-carry - POP2 DUP #ff EQU ?&overflow INC #0000 #0000 JMP2r - &overflow #0000 DIV +@round-up-to-512 ( carry^ hi* lo* -> chl^** ) + DUP2 #01ff AND2 ORA ?{ JMP2r } + DUP2 #fe00 GTH2 ?{ #0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r } + POP2 DUP2 #ffff EQU2 ?{ INC2 #0000 JMP2r } + POP2 INC #0000 #0000 JMP2r + +@dump-longer ( carry^ long** -- ) + STH2 STH2 dump-byte STH2r STH2r ( >> ) +@dump-long ( long** -- ) + SWP2 dump-short ( >> ) +@dump-short ( short* -- ) + SWP dump-byte ( >> ) +@dump-byte ( byte^ -- ) + DUP #04 SFT /hex #0f AND ( >> ) + &hex #30 ADD DUP #39 GTH #27 MUL ADD #18 DEO + JMP2r + +@dump-mem ( start* size* -> ) + OVR2 ADD2 SWP2 ( lim* start* ) + LDAk dump-byte INC2 ( lim* start+1* ) + &loop GTH2k ?&ok POP2 POP2 #0a18 DEO JMP2r ( lim^ pos^ ) + &ok #2018 DEO LDAk dump-byte INC2 !&loop ( lim^ pos+1^ ) + +@dump-mem0 ( start* size* -> ) + #0001 SUB2 OVR2 ADD2 SWP2 + &loop GTH2k ?{ NIP2 LDA #18 DEO #2018 DEO JMP2r } + LDAk #30 GTH ?{ #2018 DEO INC2 !&loop } + LDAk #18 DEO INC2 ( >> ) + &loop2 GTH2k ?{ NIP2 LDA #18 DEO #2018 DEO JMP2r } + LDAk #18 DEO INC2 !&loop2 + +@dump-header ( -> ) + LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO + ;header/filename #0064 dump-mem + ;header/mode #0008 dump-mem + ;header/owner #0008 dump-mem + ;header/group #0008 dump-mem + ;header/size #000c dump-mem + ;header/mtime #000c dump-mem + ;header/checksum #0008 dump-mem + ;header/type #0001 dump-mem + ;header/linkname #0064 dump-mem + LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO + LIT2 "s 18 DEO #2018 DEO + ;header/size load-octal11 dump-longer #0a18 DEO + LIT2 "t 18 DEO #2018 DEO + ;header/size load-octal11 round-up-to-512 dump-longer #0a18 DEO + LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO + JMP2r ( header/size is 11 octal digits; 12th digit is NUL ) ( octal 77777777777 = #01 #ffff #ffff )